代碼不會將特定的單元格復制並粘貼到新工作表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 = 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

無需任何幫助（“ Report2”）表

您可以過濾數據單元格的相關部分，然后將所選單元格直接復制到“ Clean”工作表中，如下所示

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