コードはコピーして新しいシートに特定のセルを貼り付けません。

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 = W 
W = "Chicago" 

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

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

End Sub 

はあなたが助けることができるなら、私に教えてください。ありがとう！

Answer 1

どんなヘルパー（「報」）シートは必要ありません

あなたは、データ・セルの関連部分をフィルタリングし、

Option Explicit 

Sub BranchCount() 

Dim s1 As Worksheet, sC As Worksheet 
Dim LastRow As Long 

Set s1 = Worksheets("Report 1") 
Set sC = Sheets("Clean") 

With s1 
    LastRow = .Cells(.Rows.Count, "J").End(xlUp).Row 
    With .Range("A1:J" & LastRow) 
     .AutoFilter field:=10, Criteria1:="Chicago" 
     With .Offset(1).Resize(.Rows.Count - 1) 
      If Application.WorksheetFunction.Subtotal(103, .Columns("J")) > 1 Then .SpecialCells(xlCellTypeVisible).Copy Destination:=sC.Range("A700").End(xlUp).Offset(1, 0) 
     End With 
     .AutoFilter 
    End With 
End With 

End Sub