Macro que copie más de 65000 filas
Hace días me mandaste una macro que filtra archivos de una carpeta y me los copia en una hoja abierta, todo bien, pero resulta que tengo que filtrar más o menos 600 archivos y los datos copiados no pasan de la fila 65.000, es decir cuando detecta que esta cerca de ese valor sale mensaje de error.
Se puede hacer algo esta era la macro. La estoy corriendo como libro de excel 97-2003, pero también la grabe como 2010 y ahí si sale error al principio.
Sub Filtrar()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
h1.Cells.Clear
Set h3 = l1.Sheets("datos")
ruta = l1.Path & "\"
ChDir ruta
'
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Selecciona una carpeta"
.AllowMultiSelect = False
.InitialFileName = ruta
If .Show <> -1 Then Exit Sub
cp = .SelectedItems(1)
End With
'
ChDir cp & "\"
archi = Dir("*.xls*")
Do While archi <> ""
Set l2 = Workbooks.Open(archi)
Set h2 = l2.ActiveSheet
h2.Range("A13:H" & h2.Range("E" & Rows.Count).End(xlUp).Row).AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=h3.Range("A1:B3"), Unique:=False
u = h2.Range("E" & Rows.Count).End(xlUp).Row
If u > 13 Then
u1 = h1.Range("E" & Rows.Count).End(xlUp).Row + 1
h2.Rows(14 & ":" & u).Copy h1.Range("A" & u1)
u3 = h1.Range("E" & Rows.Count).End(xlUp).Row
h1.Range("J" & u1 & ":J" & u3) = h2.[C3]
h1.Range("K" & u1 & ":K" & u3) = h2.[C6]
End If
h2.Range("a13:j13").Copy h1.Range("a1:j1")
l2.Close False
archi = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Terminado"
End Sub
Cordial saludo.