Question

我正在研究一个宏，它将搜索不同县的List表，然后将整行粘贴到当前工作表上。我有一个每个人的工作表（名为马克，约翰等），每个人都被分配了几个县。马克有三个县，列在单元格J1：L1中，我将其命名为范围（MyCounties）。我需要一个宏来查看每个县的Sheet“List”列“I”，并将整行复制到Sheet“Mark”，从“A4”开始。我正在使用我在这里找到的修改过的宏，但我一定做错了。它目前在Set Rng = Sheets("List").Range([I4], Range("I" & Rows.Count).End(xlUp))

方面给出了一个错误“应用程序定义或对象定义错误”

Sub NewSheetData()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Dim Rng As Range, rCell As Range

Set Rng = Sheets("List").Range([I4], Range("I" & Rows.Count).End(xlUp))

For Each rCell In Range("MyCounties")
    On Error Resume Next
        With Rng
            .AutoFilter , field:=1, Criteria1:=rCell.Value
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            .AutoFilter
        End With
    On Error GoTo 0
Next rCell

Application.EnableEvents = True

End Sub

Answer 1

需要调整此代码以适应您的命名范围和工作表名称。它目前使用带有每个工作表的工作表范围的命名范围。

Sub NewSheetData()
    Dim w As Long, sWSs As Variant, vCrit As Variant, rw As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    sWSs = Array("Mark", "John", "etc")

    For w = LBound(sWSs) To UBound(sWSs)
        With Worksheets(sWSs(w))
            vCrit = .Range("MyCounties").Value2
            rw = Application.Max(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, 4)
        End With

         With Worksheets("List")
            If .AutoFilterMode Then .AutoFilterMode = False
            With .Range(.Cells(4, "I"), .Cells(.Rows.Count, "I").End(xlUp))
                .AutoFilter field:=1, Criteria1:=vCrit, Operator:=xlFilterValues
                With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        .Cells.EntireRow.Copy Destination:=Worksheets(sWSs(w)).Cells(rw, "A")
                    End If
                End With
            End With
            If .AutoFilterMode Then .AutoFilterMode = False
        End With
   Next w

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

这将使用每个工作表的 MyCounties 命名范围中的值作为.AutoFilter的条件数组。使用数组作为条件需要Operator:=xlFilterValues参数。它还会检查以确保在复制之前要复制过滤值。

Answer 2

可能是您的EntireRow正在复制第一列为空白的行

您可以使用工作表对象的UsedRange属性来获取上次使用的行

此外，你最好放置With Rng ous循环，因为它不会随之改变

Option Explicit

Sub NewSheetData()
    Dim Rng As Range, rCell As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With Sheets("List")
        Set Rng = .Range("I4", .Range("I" & .Rows.Count).End(xlUp))
    End With

    With Rng
        For Each rCell In Range("MyCounties")
            .AutoFilter , Field:=1, Criteria1:=rCell.Value
            If Application.WorksheetFunction.Subtotal(103, .cells) > 1 Then .Resize(.Rows.Count - 1).Offset(1).EntireRow.Copy _
            Sheets("Sheeta2").Range("A" & Sheets("Sheeta2").UsedRange.Rows(Sheets("Sheeta2").UsedRange.Rows.Count).Row).Offset(1)
        Next
        .Parent.AutoFilterMode = False
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

使用多个条件将行从一个表复制到另一个表

2 个答案: