données excel

Sub CréeListe()
Dim FSo As FileSearch, Dossier As String, Wkb As Workbook
Dim Nom As String, Prénom As String, Adresse As String, Adresse2 As String, Téléphone As String
Dim Mail As String, DateInsc As Date, Lignes As Long, i As Long
    Dossier = "C:\temp" 'C'est ici que tu devra mettre le chemin de ton dossier
    Set FSo = Application.FileSearch
        With FSo
        .NewSearch
        .LookIn = Dossier
        .Filename = "*.xls"
            If .Execute() > 0 Then
                For i = 1 To .FoundFiles.Count
                   Set Wkb = Workbooks.Open(.FoundFiles(i))
                   Lignes = Wkb.Worksheets("Sheet1").Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Rows.Count
                    For j = 1 To Lignes
                        Select Case Wkb.Worksheets("Sheet1").Range("A" & j).Value
                            Case "Nom"
                                Nom = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                            Case "Prénom"
                                Prénom = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                            Case "Adresse"
                                Adresse = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                                Adresse2 = Wkb.Worksheets("Sheet1").Range("F" & j + 1).Value
                            Case "Téléphone"
                                Téléphone = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                            Case "email"
                                Mail = Wkb.Worksheets("Sheet1").Range("F" & j).Value
                            Case "Date d'inscription"
                                DateInsc = CDate(Wkb.Worksheets("Sheet1").Range("F" & j).Value)
                        End Select
                    Next j
                   Wkb.Close False
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 1).Value = Nom
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 2).Value = Prénom
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 3).Value = Adresse & " " & Adresse2
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 4).Value = Téléphone
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 5).Value = Mail
                   ThisWorkbook.Worksheets("Feuil1").Cells(i + 1, 6).Value = DateInsc
                   Nom = ""
                   Prénom = ""
                   Adresse = ""
                   Adresse2 = ""
                   Téléphone = ""
                   Mail = ""
                   DateInsc = CDate("1/1/1900")
                Next i
            End If
        End With
End Sub