Mover y convertir a pdf libros de Excel que estén en una carpeta especifica

Estoy trabajando con una macro para mover los archivos de Excel que estén en una carpeta a otra carpeta, indistintamente del nombre del archivo y poder convertir al pdf esos archivos.

Pero me entra en bucle y no sé muy bien como continuar, adjunto código (la macro está en otro libro):

Sub moverarchivos()
On Error GoTo FIN

Dim Archivos As String
Dim Archivos2 As String

Archivos = Dir("C:\Users\Usuario\Desktop\Nueva carpeta\*.xlsb")
Archivos2 = Dir("C:\Users\Usuario\Desktop\reportados\*.xlsb")
On Error Resume Next

Do While Archivos <> ""
Workbooks.Open "C:\Users\Usuario\Desktop\Nueva carpeta\" & Archivos

Dim i As Integer
For i = 1 To Worksheets.Count
If Left(Worksheets(i).Name, 6) = "Hoja" Then
Sheets(i).Activate
End If
Next i

' condicion para convertir solo hojas 
If ActiveSheet.Name = "Hoja_1" Then
Sheets("Hoja_1").Select
Else
If ActiveSheet.Name = "Hoja_2" Then
Sheets(Array("Hoja_1", "Hoja_2")).Select
End if

On Error Resume Next

des = Range("A1")
Set h2 = ActiveWorkbook
wpath = ActiveWorkbook.Path & "\"
Nombre = h2.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

ActiveWorkbook.Close SaveChanges = False

'Call EliminarArchivos

Name "C:\Users\Usuario\Desktop\Nueva carpeta\" & Archivos As "C:\Users\Usuario\Desktop\reportados\" & Archivos2
Loop

FIN:

End Sub