Bom dia!!!

Consegui algo mas, terá que adaptar..

Autor: Ger Plante

Public Sub Load_text_Files()
     
    Const PATH = "C:MYTEXTFILES" ' Change this to suit your needs
     
    Dim My_Filenumber As Integer
    Dim My_File As String
    Dim My_Data As String
    Dim My_Array As Variant
    Dim WS As Worksheet
     
    My_File = Trim(Dir(PATH))
     
    If My_File = "" Then
        MsgBox "No Files found matching " & PATH & My_Extension
        Exit Sub
    End If
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
     'remove any worksheet in workbook except current worksheet
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> ActiveSheet.Name Then
            WS.Delete
        End If
    Next
     
     'load each file
    While My_File <> ""
        AddSheetIfMissing (My_File)
        Worksheets(My_File).Activate
        My_Filenumber = FreeFile
        With ActiveSheet
            Open PATH & My_File For Input As #My_Filenumber
            While Not EOF(My_Filenumber)
                Line Input #My_Filenumber, My_Data
                My_Array = Split(My_Data, ",") 'split the string at every comma.... store result in any array
                .Range(Cells(.Range("A65536").End(xlUp).Row + 1, 1), Cells(.Range("A65536").End(xlUp).Row + 1, UBound(My_Array))) = My_Array 'output the array into each column
            Wend
            Close My_Filenumber
            My_File = Dir 'get next file
        End With
    Wend
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
     
End Sub
 
 
Function AddSheetIfMissing(Name As String) As Worksheet
     
    On Error Resume Next
    Set AddSheetIfMissing = ThisWorkbook.Worksheets(Name)
    If AddSheetIfMissing Is Nothing Then
        Set AddSheetIfMissing = ThisWorkbook.Worksheets.Add
        AddSheetIfMissing.Name = Name
    End If
     
End Function

Alem do modelo informado pelo Alexandre, segue abaixo um outro exemplo (verifica todo um diretorio, se for "xls" abre e copia os dados, no seu caso CSV)
Tambem pode dar uma olhadinha neste topico http://www.planilhando.com.br/forum/viewtopic.php?f=25&t=2587&start=10 , sobre importação.
Se não conseguir adaptar um dos exemplos, poste um exemplo de suas planilhas.

Sub Carrega_Evolucao()
Dim Msg As String
Dim OldName As String, NewName As String, cSheet As String
Dim rw As Long, rw2 As Long
Dim i As Long
Dim sDir As String, sPath As String

OldName = ThisWorkbook.Name
cSheet = "Evoluções" 'ActiveSheet.Name
Sheets(cSheet).Select

sPath = ThisWorkbook.Path 'Cells(1, 11)

If Right(sPath, 1) <> "" Then
    sPath = sPath & ""
    Else
    sPath = sPath
End If

ChDir sPath
sDir = Dir("*.xls?")
Do While sDir <> ""
           If sDir <> OldName Then
              'Application.DisplayAlerts = False
              'Application.ScreenUpdating = False
rw = Sheets(cSheet).Cells(Cells.Rows.Count, "A").End(xlUp).Row 'Cells(1, Cells.Columns.Count).End(xlToLeft).Column
              Workbooks.Open Filename:=sDir, UpdateLinks:=0
              rw = rw + 1
              Sheets("Evol.").Select
                 rw2 = rw
               For i = 11 To 25
                 If Cells(i, 1) <> "" Then
                 Msg = Workbooks(sDir).Sheets("Síntese").Cells(11, 5).Value
                 Workbooks(OldName).Sheets(cSheet).Cells(rw2, 1) = Workbooks(sDir).Sheets("Síntese").Cells(11, 5).Value
                 Workbooks(OldName).Sheets(cSheet).Cells(rw2, 2) = Workbooks(sDir).Sheets("Síntese").Cells(43, 3).Value
                 Workbooks(OldName).Sheets(cSheet).Cells(rw2, 3) = Workbooks(sDir).Sheets("Evol.").Cells(i, 1).Value
                 Workbooks(OldName).Sheets(cSheet).Cells(rw2, 4) = Workbooks(sDir).Sheets("Evol.").Cells(i, 2).Value
                 Workbooks(OldName).Sheets(cSheet).Cells(rw2, 5) = Workbooks(sDir).Sheets("Evol.").Cells(i, 3).Value
                 Workbooks(OldName).Sheets(cSheet).Cells(rw2, 6) = Workbooks(sDir).Sheets("Evol.").Cells(i, 4).Value
                rw2 = rw2 + 1
                Else
                'Next
                End If
                Next
              Workbooks(sDir).Close SaveChanges:=False
            sDir = Dir
            Else
            Exit Sub
            End If
Loop
    'Application.ScreenUpdating = True
    'Application.DisplayAlerts = True
End Sub

Alex, gostei do script eu encontrei um que encontra o arquivo mas não consegui fazer copiar o conteudo

Consegue me ajudar?

Sub Importfiles()
    Dim strPath As String 'Directory Path
    Dim strFile As String 'Filename
    Dim strFileList() As String 'File  Array
    Dim intFile As Integer 'File Number
     
    On Error Resume Next
     
    strPath = InputBox("Especifique o caminho dos Arquivos", "Especificar Diretório ...")
    If Right(strPath, 1) <> "" Then
    strPath = strPath & ""
    MsgBox strPath
    Else
    End If
    intFile = 0
     
     'Loop through the folder & build file list
    strFile = Dir(strPath & "*.CSV")
    MsgBox strFile
    While strFile <> ""
         'add files to the list
        intFile = intFile + 1
        ReDim Preserve strFileList(1 To intFile)
        strFileList(intFile) = strFile
        strFile = Dir()
    Wend
     'see if any files were found
    If intFile = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
     'cycle through the list of files &  import to Access
     'creating a new table called MyTable
    For intFile = 1 To UBound(strFileList)
        
'        DoCmd.TransferText acImportDelimi, , "addresspoint", strPath & strFileList(intFile), False, , ""
         'Check out the TransferSpreadsheet options in the Access
         'Visual Basic Help file for a full description & list of
         'optional settings
    Next
    MsgBox UBound(strFileList) & " Files were Imported"
End Sub

Boa tarde!!!

Testou os códigos postados por mim e pelo Reinaldo?

Att

doCavaco,
O código que vc postou está "direcionado" para transferir os arquivos existentes no diretório, para o Access (importação de dados via access), o excel "encara" essas transferencias um pouco diferente, é preciso abrir o arquivo desejado, copiar os dados para outro ou salvar esse arquivo como pasta do excel, se bem que via conexão ado(por exemplo) pode ser feita diferente.
Então desde a linha:" strFile = Dir(strPath & "*.CSV")" deve ser reconfigurado.