Extraire une cellule de plusieurs fichiers Excel pour créer un fichier exce

Bonjour, Je souhaite créer un fichier excel avec une liste d'adresse mail.

Toutes ces adresses mail sont enregistrées dans plusieurs fichiers excel, sur le même nom de cellule (D9).

Le but est de faire un mail à tous mes clients dont j'ai créer, pour chacun, un fichier excel.

Je joins le fichier exemple.

Merci beaucoup.

35fichier-client.xlsx (32.65 Ko)

Bonjour,

Voici un exemple pour récupérer les adresses courriel

Avant d 'exécuter la macro, n'oublie pas de modifier les lignes qui ont un commentaire " à adapter "

et activer la référence: Microsoft ActiveX Data Objects xx Library -->au menu vba, Outils, Référence

Sub Read_File_one_Range()
Dim Repertoire As String, Fichier As String, Feuille As String, AddrLire As String
Dim Ligne As Long, oFile As Object

'Sheets.Add After:=Sheets(Sheets.Count)  'à adapter

Repertoire = "C:\Users\isabelle\Documents\Test9"  'à adapter

Set fso = CreateObject("Scripting.FileSystemObject")
Set sfofolder = fso.GetFolder(Repertoire)
NomFeuille = "Donnees$" 'à adapter
AddrLire = "D9:D9"
Ligne = 2

 For Each oFile In sfofolder.Files
    If Right(oFile, 5) = ".xlsx" Then  'à adapter

        Set Cnn = New ADODB.Connection
        '--- Connexion ---
        With Cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & oFile & ";Extended Properties=""Excel 12.0;HDR=NO;"""
        .Open
        End With

        '--- récupérer les données --
            Set rs = Cnn.Execute("SELECT * FROM [" & NomFeuille & AddrLire & "]")
            Cells(Ligne, "A").CopyFromRecordset rs
            rs.Close
            Ligne = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

    End If
 Next oFile
Cnn.Close
Set rs = Nothing
Set Cnn = Nothing
End Sub
Rechercher des sujets similaires à "extraire fichiers creer fichier exce"