Macro en excel 2010 marca error 400

Tengo el siguiente código que lo que se supone que debe hacer es seleccionar una carpeta y abrir todos los archivos que contiene y como todos los archivos son iguales a todos les va agregar una nueva hoja y ahí va acomodar los datos.

Sub varios_archivos()
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONA LA CARPETA A ZUMBAR", 0, "c:\").items.Item.Path
ChDir carpeta & "\"
archi = Dir("*.xml*")
Do While archi <> ""
Workbooks.Open archi
Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Previous.Select
    Range("J6").Select
    Range("J6:J7").Select
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveSheet.Paste
    Range("A3").Select
    ActiveSheet.Previous.Select
    Range("J18:J26").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A4").Select
    ActiveSheet.Previous.Select
    Range("J36:J44").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A5").Select
    ActiveSheet.Previous.Select
    Range("J54:J62").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A6").Select
    ActiveSheet.Previous.Select
    Range("J72:J80").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A7").Select
    ActiveSheet.Previous.Select
    Range("J90:J98").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A8").Select
archi = Dir()
Loop
End Sub

Pero al final sólo abre el primer archivo y marca Error 400, sólo eso