Excel VBA使用自动过滤器复制行

Question

希望使用 VBA 从除我的活动工作表之外的所有工作表中复制满足 J 列中特定条件的行。

没有用 VBA 编写代码的经验，所以我试图通过查看其他问题和答案将必要的部分组合在一起；

下面是我目前写的代码；

Sub CommandButton1_Click()

  Dim lngLastRow As Long
  Dim ws As Worksheet
  Dim r As Long, c As Long
  Dim wsRow As Long

  Set Controlled = Sheets("Controlled") ' Set This to the Sheet name you want all Ok's     going to

  Worksheets("Controlled").Activate
  r = ActiveSheet.Cells(Rows.Count, 2).End(x1up).Row
  c = ActiveSheet.Cells(1, Columns.Count).End(x1ToLeft).Column
  Range("J").AutoFilter

  For Each ws In Worksheets
    If ws.Name <> "Controlled" Then
       ws.Activate
       wsRow = ActiveSheet.Cells(Rows.Count, 2).End(x1up).Row + 1
       Range("A" & r).AutoFilter Field:=10, Criteria1:="Y"
       .Copy Controlled.Range("A3" & wsRow)
    End If 
  Next ws
End If


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

其中 Controlled 是我希望数据出现在其他工作表中的工作表，并搜索所有其他工作表以查看其列 J 是否符合条件 =“Y”

我不需要复制格式，因为所有表格的格式都完全相同，如果可能，我希望复制的行从第 3 行开始

Answer 1

试试这个：

Option Explicit
Sub ConsolidateY()

Dim ws As Worksheet, wsCtrl As Worksheet
Dim lrow As Long, rng As Range

Set wsCtrl = Thisworkbook.Sheets("Controlled")

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

For Each ws In Thisworkbook.Worksheets
    If ws.Name = "Controlled" Then GoTo nextsheet
    With ws
        lrow = .Range("J" & .Rows.Count).End(xlUp).Row
        .AutoFilterMode = False
        Set rng = .Range("J1:J" & lrow).Find(what:="Y", after:=.Range("J" & lrow))
        If rng Is Nothing Then GoTo nextsheet
        .Range("J1:J" & lrow).AutoFilter Field:=1, Criteria1:="Y"
        .Range("J1:J" & lrow).Offset(1,0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        wsCtrl.Range("A" & wsCtrl.Rows.Count).End(xlUp).Offset(1,0).PasteSpecial xlPasteValues
        .AutoFilterMode = False
        Application.CutCopyMode = False
    End With
nextsheet:
Next

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

我认为这涵盖了您的所有或大部分要求。
虽然没有测试，所以我把它留给你。
如果您遇到问题，请告诉我。