bueno mi estimado, la verdad aun no he logrado entender todo el codigo y lo que he logrado comprender no se si lo he comprendido correctamente.
lo unico que hice fue modificar un poco el codigo:
Código:
Option Explicit
Sub Consolidar()
'---------------------------
' By Cacho Rodríguez
'---------------------------
Dim mySh As Worksheet, NextRow As Long, qRows As Long
Application.ScreenUpdating = False
[A2].CurrentRegion.Offset(2).Delete xlShiftUp
For Each mySh In Worksheets
If Not mySh Is ActiveSheet Then
mySh.AutoFilterMode = False
With mySh.[A2].CurrentRegion
.AutoFilter 4, "open"
NextRow = 1 + Cells(Rows.Count, "B").End(xlUp).Row
.Offset(1).Copy Cells(NextRow, "B")
qRows = WorksheetFunction.Subtotal(103, .Columns(5)) - 1
If qRows > 0 Then Cells(NextRow, "A").Resize(qRows) = mySh.Name
End With
mySh.AutoFilterMode = False
End If
Next
Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub