Favor revisar este código

Estimados tengo la siguiente macro pero no me funciona del todo bien, necesito que recorra una capeta especifica pero recorre todos los archivos excel de pc como lo puedo solucionar.

Sub juntar()
Dim hoja As Object
Application.DisplayAlerts = False
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path
ChDir ruta & "\"
archi = Dir("*.xls*")
While archi <> ""
If archi <> mio Then
Workbooks.Open archi
otro = ActiveWorkbook.Name
'For Each hoja In ActiveWorkbook.Sheets
'hoja.Copy After:=Workbooks(mio).Sheets(Workbooks(mio).Sheets.Count)
'Next
ActiveWorkbook.Sheets(1).Copy After:=Workbooks(mio).Sheets(Workbooks(mio).Sheets.Count)
Workbooks(otro).Close False
End If
archi = Dir()
Wend
End Sub