特定の文字列名のセルをVBAにコピー/貼り付けするときの問題

Question

このコードを使用して、ワークシート "Report2"の各行を "Chicago"というフレーズでチェックし、 "Chicago"という行をコピーして貼り付けます新しいシートに入れる。しかし、それは動作していません。なぜ歓迎されるのかについての助け。

Sub BranchCount() 

Dim s As Worksheet 
Dim LastRow As Long 

Set s = Worksheets("Report 1") 
LastRow = s.UsedRange.SpecialCells(xlCellTypeLastCell).Row 

Worksheets("Report 1").Select 
Range("A1:J" & LastRow).Select 
Selection.Copy 

Sheets.Add.Name = "Report2" 
Selection.PasteSpecial xlPasteValues 
Range("A1").EntireRow.Delete 
Range("B1").EntireRow.Delete 
Range("C1").EntireRow.Delete 

Dim Z As Range 
Dim Y As String 

Y = "Chicago" 

Dim Q As Worksheet 
Dim LastRow2 As Long 

Set Q = Worksheets("Report2") 
LastRow2 = Q.UsedRange.SpecialCells(xlCellTypeLastCell).Row 

Sheets("Report2").Range("A1").Select 

For Each Z In Range("J1:J" & LastRow2) 
    If Y = Z.Value Then 
     Z.EntireRow.Copy 
      Sheets("Clean").Select 
       Range("A500").End(xlUp).Offset(1, 0).Select 
       Selection.PasteSpecial xlPasteValues 
      Sheets("Report2").Select 
    End If 
Next 

End Sub 

私はExcel 2013を使用しています。お手伝いできますか教えてください。ありがとう！

Answer 1

ワークシート変数を使用して、いくつかのクリーンアップを試みました。あなたはそれらを使用し始めましたが、どこにでもそれらを実装する必要があります（私のコメントのリンクを再度参照してください）。 （F8は、一度に1つの行をステップ実行するために使用します）

は、私はあなたのデータがあった場所、私は理解だと思うが、あなたは以下の微調整が必​​要な場合があります

Sub BranchCount() 
Dim rptOneWS As Worksheet, rptTwoWS As Worksheet 
Dim s As Worksheet 
Dim LastRow As Long 

Set rptOneWS = Worksheets("Report 1") 
Set rptTwoWS = Sheets.Add 
rptTwoWS.Name = "Report 2" 

LastRow = rptOneWS.UsedRange.SpecialCells(xlCellTypeLastCell).Row 

'If you just want values, set two ranges equal. That way you 
' skip using the clipboard 
rptTwoWS.Range("A1:J" & LastRow).Value = rptOneWS.Range("A1:J" & LastRow).Value 
With rptTwoWS 
    .Range(.Rows(1), .Rows(3)).EntireRow.Delete 
End With 

Dim Z As Range 
Dim Y As String 

Y = "Chicago" 

Dim LastRow2 As Long 

LastRow2 = rptTwoWS.UsedRange.SpecialCells(xlCellTypeLastCell).Row 

For Each Z In rptTwoWS.Range("J1:J" & LastRow2) 
    If Y = Z.Value Then 
     Z.EntireRow.Copy 
      Sheets("Clean").Range("A500").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
    End If 
Next 

End Sub