回答編集履歴

2

コード追記

2020/05/28 12:42

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -91,3 +91,83 @@
91
91
  結局、無意味な部分が多すぎてコードを見ただけでは何をしたいのか把握できません。
92
92
 
93
93
  言葉で、何をしたいのかを詳細に説明してもらえますか。
94
+
95
+
96
+
97
+
98
+
99
+ ---
100
+
101
+ 提示された情報から最大限推測して、下記のような仕様だと仮定したコード例を提示しておきます。
102
+
103
+
104
+
105
+ 仕様
106
+
107
+ "Data”シートに1行毎にフィルタ条件が記述してある
108
+
109
+ このフィルタ条件で"Sheet1"シートのデータにフィルターをかけて、それを"Sheet2"に順次追加コピーしていく。
110
+
111
+
112
+
113
+ コード例
114
+
115
+ ```vba
116
+
117
+ Private Sub CommandButton3_Click()
118
+
119
+ Dim MotoRng As Range
120
+
121
+ Set MotoRng = Worksheets("Sheet1").Range("A1")
122
+
123
+
124
+
125
+ With Worksheets("Data")
126
+
127
+ Dim maxRow As Long
128
+
129
+ maxRow = .Range("A" & Rows.Count).End(xlUp).Row
130
+
131
+ '"Data"の2行目から順にループ処理
132
+
133
+ Dim rw As Long, cl As long
134
+
135
+ For rw = 2 To MaxRow
136
+
137
+ MotoRng.AutoFilter 'AutoFilter解除
138
+
139
+ '1列目から6列目までを条件にフィルターをかける
140
+
141
+ For cl = 1 To 6
142
+
143
+ MotoRng.AutoFilter cl, .Cells(rw, cl).Value
144
+
145
+ Next
146
+
147
+ 'フィルターをかけた"Sheet1"のデータを"Sheet2"に追加コピーする
148
+
149
+ With Worksheets("Sheet2")
150
+
151
+ Dim Sheet2MaxRow As Long
152
+
153
+ Sheet2MaxRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
154
+
155
+ MotoRng.CurrentRegion.Copy .Range("A" & Sheet2MaxRow)
156
+
157
+ End With
158
+
159
+ Next
160
+
161
+ End With
162
+
163
+
164
+
165
+ MotoRng.AutoFilter 'AutoFilter解除
166
+
167
+
168
+
169
+ End Sub
170
+
171
+ ```
172
+
173
+ テキストエディタ直書きなので動作確認してませんので、おかしなところがあるかも知れません。ロジックを参考にしてください。

1

コード修正

2020/05/28 12:42

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -48,7 +48,7 @@
48
48
 
49
49
  .AutoFilter 'AutoFilter解除
50
50
 
51
- .AutoFilter 1, Kw(1) '※繰り返しフィルターをかけているだけで無意味なコード
51
+ .AutoFilter 1, Kw(1)
52
52
 
53
53
  .AutoFilter 2, Kw(2)
54
54