Bom dia!!

Crie uma pasta Ex: MinhaPasta, nele deixo os arquivos que quer importar.

o código abaixo, vai abrir todos os arquivos (com a extenção .xlsx) que está dentro da pasta criada de nome minhaPasta, copiar os dados para o arquivo ativo.

Option Explicit

Sub AleVBA_17876()
    Dim sPath As String
    Dim sFil As String
    Dim strName As String
    Dim twbk As Workbook
    Dim owbk As Workbook
    Dim ws As Worksheet
     
    Set twbk = ActiveWorkbook
    sPath = "C:UsersalexandreVBAMinhaPasta" 'Mude o caminho para o seu diretório
    sFil = Dir(sPath & "*.xlsx") 'Eu uso a extensão .xlsx, caso vc contrario mude para .xls
     
    Do While sFil <> ""
        strName = sPath & sFil
        Set owbk = Workbooks.Open(strName)
        Set ws = owbk.Sheets(1)
        ws.Range("A2", Range("C" & Rows.Count).End(xlUp)).Copy
        twbk.Sheets("Plan1").Range("A65536").End(xlUp)(2).PasteSpecial xlPasteValues
        owbk.Close False
        sFil = Dir
    Loop
     
    twbk.Save
End Sub

Att

Uma outra alternativa seria :

Sub Base_Mauro()
    '
    ' Buscar Clientes e Vendas BASEs

        'Calculo Manual
        Application.Calculation = xlManual
        
        'Criamos o objeto
        Set fs = CreateObject("Scripting.FileSystemObject")
        
        'Nao Apresentar Caixa de Dialogo
        Application.DisplayAlerts = False
       
        'Nao Piscar Tela
        Application.ScreenUpdating = False
       
        'Variável
        Dim Arquivo  As String
        Dim A As Boolean 'True se já estiver aberto e false caso contrário
        Dim WBName As String
        
        'Se os arquivos estiverem no mesmo diretorio deixe ThisWorkbook.Path
        ChDir ThisWorkbook.Path
        'Se for outro desabilite a linha acima ec oloque aqui o Caminho e Pasta que deseja abrir
        'ChDir "C:SeusArquivosBase"
        
        'Definido o diretorio, a caixa de dialogo abrirá no local definido acima
        FiletoOpen = Application _
        .GetOpenFilename("Excel (.xlsx), .xlsx", , "Selecione a planilha")
        
        'Verifica se foi selecionado algum arquivo, se não sai da rotina
        If FiletoOpen <> False Then
            WdlFolder = fs.getParentFolderName(FiletoOpen)
            Arquivo = fs.GetFileName(FiletoOpen)
        Else
            Exit Sub
        End If
        
            'Armazena os nomes de cada arquivo
            'Se estiver aberto
            On Error Resume Next
            WBName = Workbooks(Arquivo).Name
            If Err.Number = 0 Then
                A = False
            Else 'Se não estiver aberto
                A = True
                Workbooks.Open Filename:=WdlFolder & "" & Arquivo
            End If

        'Copiar e Colar Vendas
        Windows(Arquivo).Activate
        Sheets("Plan1").Range("A:C").Copy
        Windows(ThisWorkbook.Name).Activate
        Sheets("Plan1").Range("A1").PasteSpecial Paste:=xlPasteValues
       
        'Fechar Arquivo Origem
        If A = True Then
            Workbooks(Arquivo).Close savechanges:=False
        Else
        End If
           
        'Aponta Empresa Calculada
        Windows(ThisWorkbook.Name).Activate
        Sheets("Plan1").Range("E1").Value = Arquivo
       
        'Calculo Automatico
        Application.Calculation = xlAutomatic
       
        'Nao Apresentar Caixa de Dialogo
        Application.DisplayAlerts = True
       
        'Nao Piscar Tela
        Application.ScreenUpdating = True
           
        MsgBox "TROCA DE EMPRESA CONCLUÍDA - " & Arquivo
        
    End Sub

Resolvi colocar esta uma vez que pelo exemplo que enviou vi que apos copiar da Base1 e colar ao executar a rotina para a Base2 os dados são substituídos, não sei se é isto mesmo ou irá salvar em um novo arquivo os dados copiados.

[]s