Excel VBA - Consolidar planilhas

O código abaixo é uma simplificação de um outro escrito pelo meu amigo Edson Luiz Branco, mais ou menos no ano 2000, não lembro exatamente o ano.
Na ocasião, eu precisava copiar e colar os dados de aproximadamente 200 planilhas para uma única e este código me salvou da árdua tarefa manual.

;-)

Sub ConsolidaNovo()

    Dim i               As Integer
    Dim NomeArquivo     As String
    Dim Origem          As Workbook
    Dim Caminho         As String
    
    Caminho = InputBox("Informe o caminho da pasta que contém as planilhas" & vbCrLf & "Exemplo: C:\Pastas\")
    If Caminho = "" Then Exit Sub
    
    If Right(Caminho, 1) <> "\" Then Caminho = Caminho & "\"
    
    NomeArquivo = Dir(Caminho)
    
    i = ActiveWorkbook.Sheets.Count

    Application.ScreenUpdating = False
    Do Until NomeArquivo = ""
        
        Set Origem = Workbooks.Open(Filename:=Caminho & NomeArquivo)
        
        Origem.ActiveSheet.Copy After:=Workbooks("Consolidar.xls").Sheets(i)

        Origem.Close SaveChanges:=False
        
        ActiveSheet.Name = NomeArquivo
        i = i + 1

        NomeArquivo = Dir
        Application.ScreenUpdating = True

    Loop

    Set Origem = Nothing
    
    Sheets(1).Select

End Sub