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

不需要任何帮助（＆＃34; Report2＆＃34;）表

您可以过滤数据单元格的相关部分，并将所选单元格直接复制到＆＃34;清洁＆＃34;表格如下

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

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

1 个答案: