代码不会将特定的单元格复制并粘贴到新工作表VBA中

Question

I am using this code to check each row in worksheet "Report2" for the phrase "Chicago" and copy and paste any rows with "Chicago" in them into a new sheet. However, it is not working. Any help on why would be appreciated.

Code:

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

Let me know if you can help. Thanks!

Answer 1

no need for any helper ("Report2") sheet

you could filter the relevant part of data cells and copy selected cells directly to "Clean" sheet as follows

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