Sub transferenciaDeDados()
    transfere_dados
End Sub

Private Function transfere_dados()
    Application.ScreenUpdating = False
    Dim arquivos() As Variant
    Dim caminho As String
    Dim pastaDeTrabalho As String
    Dim pastaDeTrabalhoAtiva As String
    Dim linhaDeInicio As Integer
    caminho = ActiveWorkbook.Path
    arquivos = listfiles(caminho)
    pastaDeTrabalhoAtiva = ActiveWorkbook.Name
    linhaDeInicio = 1
    'verificação de arquivos
    For Each arquivo In arquivos
        'executa somente se para extenção .xlsx
        If InStr(1, arquivo, ".xlsx") <> 0 And _
            InStr(1, arquivo, "~$") = 0 Then
            pastaDeTrabalho = caminho & "" & arquivo
            'abre pasta de trabalho
            Workbooks.Open (pastaDeTrabalho)

            'Sua lógica aqui
            'copia valores da célula A1 da primeira planilha da pasta de trabalho aberta
            'em sequência na coluna A da primeira planilha da psta de trabalho de destino, ativa.

            Workbooks(pastaDeTrabalhoAtiva).Sheets(1).Range("A" & linhaDeInicio).Value = _
                Workbooks(arquivo).Sheets(1).Range("A1").Value

            'fecha pasta de trabalho
            Workbooks(arquivo).Close
            linhaDeInicio = linhaDeInicio + 1
        End If
        pastaDeTrabalho = ""
    Next
    pastaDeTrabalhoAtiva = ""
    linhaDeInicio = 0
End Function

Function listfiles(ByVal sPath As String)

    Dim vaArray     As Variant
    Dim i           As Integer
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then Exit Function

    ReDim vaArray(1 To oFiles.Count)
    i = 1
    For Each oFile In oFiles
        vaArray(i) = oFile.Name
        i = i + 1
    Next

    listfiles = vaArray

End Function