Copier données d'un classeur à un autre (automatique)

Bonjour à tous,

J’ai fait différentes recherche sur les forum mais je n’ai malheureusement pas trouvé la réponse à mon problème.

Pourriez-vous m’aider ou me dire si ce que je cherche à faire est impossible ?

Je vous remercie d’avance

Objectif :

Automatiser une étape fastidieuse.

Je voudrais copier les données de la première feuille de plusieurs classeurs Excel dans un nouveau classeur.

Les composants du problème :

Particularité :

- Version : Excel 2010 EN

Particularité des dizaines de classeur Excel dont je voudrais exporter les informations. Je les appellerai classeur « source ».

- Tous les classeur « source » se trouvent dans le même dossier.

• Tous les classeur « source » contiennent 1 seul page.
• Les valeurs à récupérer des fichiers « source » sont toujours dans les colonnes A,D,E
• Le nombre de ligne à copier commence toujours par 2 , mais le N° final dépend du nombre de lignes de chaque document « source »
• Un classeur Excel contient les noms de tous les classeurs « source »

Particularité du classeur qui devrait réceptionner les données. Je l’appellerai classeur « Résultat »

- Toutes les données des fichiers « source » devront être placées dans le classeur « résultat »

• Les données récupérées devront être placées dans la feuille1
• Les données récupérées devront être placées dans les colonnes A-C (si possible : A « source » = A « Résultat » ; D « source » = B « Résultat » et E « source = C »Résultat »)

- Les données récupérées devront se suivre (un espace entre chaque liste de fichier « source » différent serait un +)

Toutes les possibilités sont bonnes à prendre du code VBA à un petite programme qui me permettrais de le faire, je suis preneur !

J’espère avoir été assez claire ☺

Je passerais 2 fois par jour pour répondre à vos éventuelles questions et prendre la température.

Salutations

BAL

Bonjour,

un petit code à tester

Sub test()
  Dim wkResultat As Workbook
  Dim wkSource
  Set wk = ThisWorkbook
  repertoire = ActiveWorkbook.Path & "\"
  nf = Dir(repertoire & "*.xlsx")
  ligne = wkResultat.Range("A" & Rows.Count).End(xlUp).Row
  Do While nf <> ""
  Set wkSource = Workbooks.Open(repertoire & nf)
  For i = 2 To wkSource.Range("A" & Rows.Count).End(xlUp).Row
    wkResultat.Cells(ligne + i - 1, 1) = wkSource(i, 1)
    wkResultat.Cells(ligne + i - 1, 2) = wkSource(i, 4)
    wkResultat.Cells(ligne + i - 1, 3) = wkSource(i, 5)
  Next i
  ligne = ligne + 1
  nf = Dir ' suivant
  wkSource.Close
  wkSource = Nothing
  Loop
End Sub

désolé petit erreur :

remplacer

 
Dim wkSource
Set wk = ThisWorkbook
 

par

Dim wkSource As Workbook
Set wkResultat = ThisWorkbook  
 

merci pour votre réactivité!

je vais faire un test et je vous donne la réponse demain!

Bonjour Minanse,

j'ai analyser un peu plus ton code et je me posais une question :

tu nommes « repertoire » le classeur Excel qui contient les noms de tout les classeurs « source » ?

ou je dois créer un fichier repertoire où je place tous les fichier « source ?

Merci beaucoup !

comme tu le vois mon niveau en VBA n'est pas très elevé ☺

Bonjour,

si le classeur dans laquelle tu exécute le code vba (classeur Résultat je pense ) est dans le même dossier que tout les classeur "source" alors il n'y pas besoin de crée un nouveau dossier

dans le repertoire est le chemin du classeur "résultat"

re-bonjour,

je m'en sors malheureusement pas

le code semble tout à fait correcte, mais mon manque de niveau me bloque.

je récapitule:

• je peux supprimer le classeur Excel Repertoire. (le repertoire étant le dossier "001-Product Structure G05")
• les copies d'informations vont donc s'éffectuer sur les colonnes A,D,E de tout les classeurs excel se trouvant dans le dossier

je vous donne les infos suivantes:

le lien où se trouve mon fichier: (un exemple réel de sont contenu en photo annexe)

\\Mikron.net\group\AT\MBO\Departments\020 Development\090 Projects\030 Projects folder\2016\86.MG516 - Maintenance G05\100 Obsolescence\120 Documentation\Nomenclature\001-Product Structure G05

les numeros commençant par un "S" sont les classeurs "source"

Arivez-vous à m'aider avec ces info?

merci d'avance!

EDIT:

Savez-vous comment résoudre cette error '438'?

Un collègue programmeur ma débugger le macro !

Vous trouverez la solution ci-dessous

Sub test()
    Dim wkResultat As Workbook
    Dim wkSource As Workbook
    Dim ligne
    'Set wkResultat = ThisWorkbook
    repertoire = ActiveWorkbook.Path & "\"
    nf = Dir(repertoire & "*.xlsx")
    'ligne = wkResultat.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    ligne = ActiveSheet.UsedRange.Row
    UsedRange.Clear

    Do While nf <> ""
        If nf <> "Resultat.xlsx" Then
            Set wkSource = Workbooks.Open(repertoire & nf)
            For i = 2 To wkSource.ActiveSheet.Cells(wkSource.ActiveSheet.Rows.Count, "A").End(xlUp).Row
                'ActiveSheet.Cells(ligne + i - 1, 1) = wkSource(i, 1)
                Cells(ligne, 1) = wkSource.ActiveSheet.Cells(i, 1)
                Cells(ligne, 2) = wkSource.ActiveSheet.Cells(i, 4)
                Cells(ligne, 3) = wkSource.ActiveSheet.Cells(i, 5)
                ligne = ligne + 1
            Next i

            wkSource.Close
            ligne = ligne + 1 'espace entre 2 fichiers
        End If

        nf = Dir ' suivant
    Loop
End Sub

Salutations

Problème Résolu