VBA - フィルタリングされた行を複数回コピーする

Question

異なる条件に基づいてテーブルの行をフィルタリングしてコピーしたいとします（2つの基準を考えてみましょう）。彼らは最初の基準をsatify場合、彼らは第二を満たしている場合、行は、第二に、最初の範囲で（2個の範囲内の別のシートにコピーする必要があります。

誰かが私を助けることはできますか？事前に

シモーヌをありがとう複数の条件のコンテキストを考慮

Answer 1

は、私は配列は、あなたのコードは簡潔簡単にメンテナンスを行います使用することをお勧め

あなたは、出力データが1枚のシートにコピーする必要が想定しています。

Sub loopingFilter() 
Dim Arr1, Arr2 As Variant 
Dim i, j1, j2, St1_Row 
Dim St1, St2 

Set St1 = Sheets("Input") 
Set St2 = Sheets("Output") 
St1_Row = St1.Range("A" & Rows.Count).End(xlUp).Row 
j1 = 0: j2 = 0 

For i = St1_Row To 2 Step -1 
'assuming status is your critiria range 
Status = St1.Cells(i, 1).Value 

If Status = "YourCriteria1" Then 
    Arr1(j1) = Range("A" & i & ":Z" & i) 
    j1 = j1 + 1 'increment array index  
ElseIf Status = "YourCriteria2" Then 
    Arr2(j2) = Range("A" & i & ":Z" & i) 
    j2 = j2 + 1 'increment array index  
End If 

Next i 

'Output array into OUTPUT sheet, if put in one sheet 
St2.Range("A1:Z" & j1) = Arr1() 
St2.Range("A" & (j1 + 2) & ":Z" & j2) = Arr2() 
End Sub 

短いバージョンはUBOUNDを使用しますが、以前のようにきれいではないに見えることでしょう、私の答えは役立ちます:)

Sub loopingFilter1() 
ReDim Arr(0) : Dim i, St1_Row : Dim St1, St2 
Set St1 = Sheets("Input") : Set St2 = Sheets("Output") 
St1_Row = St1.Range("A" & Rows.Count).End(xlUp).Row 

For i = 2 to St1_Row 
'assuming status is your critiria range 
Status = St1.Cells(i, 1).Value 
    If Status = "YourCriteria" Then 
     Arr(UBound(Arr)) = Range("A" & i & ":Z" & i) 
     ReDim Preserve Arr(UBound(Arr) + 1)  
    End if 
Next i 

St2.Range("A1:Z" & UBound(Arr)) = Arr() 
End Sub