条件にフィルタをかけて、同じワークシートの下部にコピー＆ペーストします

Question

私はVBAを初めて使いました。多くの検索の後、コードが正常に動作しません。私はフィルタをかけたい/列Bの値313とC列の値1または2を持っているすべての列と同じワークシートの下部にあるすべての列（A - N）からのデータで関連するすべての行をコピーするものを選択しようとしています。ワークシートには行数が設定されておらず、313は必ずしも同じセルに含まれているわけではありません。私は以下を試しましたが、コードは下部の選択ではなく、「A2」に貼り付けられているようです。どんな助けでも大歓迎です。

Sub CopyPartOfFilteredRange() 
Dim ws1 As Worksheet 
Dim filterRange As range 
Dim copyRange As range 
Dim lastRow As Long 

Set ws1 = ThisWorkbook.Sheets("Sheet 1") 

ws1.AutoFilterMode = False 

lastRow = ws1.range("A" & ws1.Rows.Count).End(xlUp).Row 

Set filterRange = ws1.range("A1:N" & lastRow) 


Set copyRange = ws1.range("A2:N" & lastRow) 

filterRange.AutoFilter Field:=2, Criteria1:="313" 
filterRange.AutoFilter Field:=3, Criteria1:="=1", _ 
    Operator:=xlAnd, Criteria2:="=2" 


lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    ws1.Cells(lastRow, 1).Select 
ws1.Paste 


ws1.AutoFilterMode = False 
End Sub 

Answer 1

あなた必要があります持っているものです。

に貼り付けるセルを参照する1の

• 変更xlAnd

xlOrに増加 lastRow

はしてみてください（もしあれば！）フィルタ処理細胞を選択する使用SpecialCells(xlCellTypeVisible)彼

Option Explicit 

Sub CopyPartOfFilteredRange() 
    Dim lastRow As Long 

    With ThisWorkbook.Sheets("Sheet 1") 
     .AutoFilterMode = False 

     lastRow = .Range("A" & .Rows.Count).End(xlUp).row 
     With .Range("A1:N" & lastRow) 
      .AutoFilter Field:=2, Criteria1:="313" 
      .AutoFilter Field:=3, Criteria1:="1", Operator:=xlOr, Criteria2:="2" 
      If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then 'count visible cells in column "A" other than the header 
       .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy .Cells(lastRow + 1, 1) 
      End If 
     End With 

     .AutoFilterMode = False 
    End With 
End Sub 

Answer 2

私はあなたがそれをフィルタに隠すことができるので、xlUpが最後の行を欠場する使用して、フィルタの後に最後の行を再定義しているためと考えています。すでに定義された範囲の最後の行を持っていて、ちょうどその下に、過去1行にしたいので、私は

lastRow = lastRow + 1 

を使用してお勧めします。

2番目のフィルタは、セルが1に等しく2に等しくないため、何もフィルタリングしません。いずれにしても、私のコメントで言ったように、あなたは何かをコピーしているとは思わないので、フィルターの後に

filterRange.Copy 

があります。私はこのようにコピーして貼り付けることをお勧めしませんが、書き直す代わりにコードを修正しようとします。

また、私は

Set copyRange = ws1.range("A2:N" & lastRow) 

が全く必要とされ、削除することができると信じていません。

これは私がフル

Sub CopyPartOfFilteredRange() 
Dim ws1 As Worksheet 
Dim filterRange As Range 
Dim lastRow As Long 
Set ws1 = Worksheets("Sheet1") 
ws1.AutoFilterMode = False 
lastRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 
Set filterRange = ws1.Range("A1:N" & lastRow) 
filterRange.AutoFilter Field:=2, Criteria1:="313" 
filterRange.Copy 
lastRow = lastRow + 1 
ws1.Cells(lastRow, 1).Select 
ws1.Paste 
ws1.AutoFilterMode = False 
End Sub