Macro excel, copiar informacion de varios archivos.

Felices fiestas para todos, necesito su ayuda, tengo una macro donde copiar los datos de la hoja uno pero solo quiero que copie la informacion de los datos que contengan cierto nombre, al encontrar el primer archivo lo hace bien pero después no me copia la demás informacion.

Sub CONSOLIDAR_2()
'Lee archivos del directorio y Copia la hoja 1
Application.ScreenUpdating = False
ruta = "C:\Users\Carlos\Desktop\Consolidador"
ChDir ruta
archi = Dir("Consolidar informacion*.*")
Set h1 = ThisWorkbook.Sheets("hoja1")
On Error Resume Next
Do While archi <> ""
If InStr(1, archi, "nuevo") = 0 Then
Workbooks.Open archi
If Err.Number = 0 Then
Sheets(1).Select
uf1 = h1.Range("A" & Rows.Count).End(xlUp).Row
Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy _
h1.Range("B" & uf1 + 1)
uf2 = uf1 + ActiveCell.SpecialCells(xlLastCell).Row
Application.DisplayAlerts = False
Workbooks(archi).Close
Application.DisplayAlerts = True
If uf1 > 1 Then uf1 = uf1 + 1
Range("A" & uf1 & ":A" & uf2) = archi
Else
Err.Number = 0
End If
End If
archi = Dir()
Loop
Range("A1").EntireRow.Delete
End Sub