Code Won't Copy and Paste Specific Cells Into New Sheet VBA - 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