Macro Copiar información de varios archivos según su nombre

Junco saludar y desearte unas felices fiestas junto a tu familia.

Te escribo por que veo que siempre has ayudado con respecto a las macros, agradecería de tu ayuda. Recién estoy aprendiendo todo esto del mundo de la macro, tengo una macro donde copia los datos de la hoja uno pero solo quiero que copie la información de los datos que contengan cierto nombre, al encontrar el primer archivo lo hace bien pero después no me copia la información de los otros archivos.

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