Excel VBA copiando filas usando Autofilter

Question

Buscando copiar filas de todas las hojas de mi hoja activa que cumplen con un determinado criterio en la columna J usando VBA.

No experimentado en el código de escritura en VBA, por lo que he intentado reunir a Frankenstein las partes necesarias de mirar otras preguntas y respuestas;

a continuación es el código que he escrito hasta ahora;

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

Cuando se controla es la hoja, quiero que aparezcan los datos desde las otras hojas, y se buscan todas las demás hojas para ver si su columna J cumple con los criterios="y"

No necesitaré copiar el formato sobre el formato, ya que todas las hojas tendrán el formato exactamente iguales y, si es posible, quiero las filas que se copian para comenzar en la fila 3

Answer 1

Intenta esto:

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

Creo que esto cubre todo o la mayoría de sus requisitos.
Sin embargo, no se ha probado, así que lo dejo a ti.
Si te encuentras con problemas, házmelo saber.