Compiler 2 onglets de 2 classeurs différents
lobita31
Messages postés
4
Statut
Membre
-
melanie1324 -
melanie1324 -
Bonjour,
Je n'y connais rien en programmation VBA et pourtant je pense qu'un peu de code pourrait me faciliter la tache.
J'ai 2 fichiers excel de même structure (même nombre d'onglets, même noms d'onglets), contenant des données différentes
Je voudrais compiler les données de mon fichier 1 onglet "Listedonnées" avec les données de mon fichier 2 onglet "Listedonnées" dans un 3ème fichier. Les colonnes de ces 2 onglets sont identiques, je voudrais simplement copier les lignes de chacun des 2 onglets dans un nouveau classeur.
Est-ce que quelqu'un pourrait m'aider svp?
Merci
Lobita31
Je n'y connais rien en programmation VBA et pourtant je pense qu'un peu de code pourrait me faciliter la tache.
J'ai 2 fichiers excel de même structure (même nombre d'onglets, même noms d'onglets), contenant des données différentes
Je voudrais compiler les données de mon fichier 1 onglet "Listedonnées" avec les données de mon fichier 2 onglet "Listedonnées" dans un 3ème fichier. Les colonnes de ces 2 onglets sont identiques, je voudrais simplement copier les lignes de chacun des 2 onglets dans un nouveau classeur.
Est-ce que quelqu'un pourrait m'aider svp?
Merci
Lobita31
3 réponses
-
Bonjour,
Crées ton 3 ème fichier avec tes onglets.
va dans Outils, Marco, vba :
sur cet écran fais insertion, module et copies ce code :
Sub AfficheOnglets()
Dim Onglets As Worksheet
Dim a, i, j, fichier3, fichier As Variant
fihier3 = ActiveWorkbook.Name
For a = 1 To 2 'une boucle qui focntionne 2 fois pour tes 2 fichiers
Application.Dialogs(xlDialogOpen).Show 'sélectionne ton fichier de travail
fichier = ActiveWorkbook.Name 'sélectionen ton fichier où tes deux fichiers vont être rassemblés
For Each Onglets In Worksheets 'pour chaque onglet
Workbooks(fichier3).Activate
Sheets(Onglets).Select
If a = 1 Then 'si c'est pour le premier fichier
Cells.Clear 'on vide tes onglets
Workbooks(fichier).Activate
Sheets(Onglets).Select 'on copie ton onglet
Cells.Copy
Workbooks(fichier3).Activate
Cells.Paste 'on le colle dans ton nouveau fichier
Else
i = 1 'on balaie ta première colonne
Do While Cells(i, 1) <> "" 'on va rechercher la dernière ligne de ta première colonne bref jusqu'à ce qu'il n'y ait rien
i = i + 1
Loop
Workbooks(fichier).Activate 'on va faire de même dans ton deuxième fichier
j = 1
Do While Cells(j, 1) <> "" 'on va rechercher la dernière ligne de ta première colonne bref jusqu'à ce qu'il n'y ait rien
j = j + 1
Loop
Range(Rows(2), Rows(j)).Copy
Workbooks(fichier3).Select
Rows(i).Select
ActiveSheet.Paste
Cells(1, 1).Select
End If
Next Onglets
Workbooks(fichier).Close
Next a
End Sub
Afin que tu comprennes mieux rapetisse un peu ta fenêtre vba et appuie sur F8, ca executera le code ligne par ligne et t'aideras à comprendre.-
Bonjour melanie1324.
Je viens de tester le code et j'ai un message d'erreur sur la ligne Cells.Paste erreur d'execution 438
Voilà ce que j'ai collé :
Sub AfficheOnglets()
Dim Onglets As Worksheet
Dim a, i, j, LabDailyTaskbloc4compile, fichier As Variant
LabDailyTaskbloc4compile = ActiveWorkbook.Name
For a = 1 To 2 'une boucle qui focntionne 2 fois pour tes 2 fichiers
Application.Dialogs(xlDialogOpen).Show 'sélectionne ton fichier de travail
fichier = ActiveWorkbook.Name 'sélectionen ton fichier où tes deux fichiers vont être rassemblés
For Each Onglets In Worksheets 'pour chaque onglet
Workbooks(LabDailyTaskbloc4compile).Activate
Sheets("Listing").Select
If a = 1 Then 'si c'est pour le premier fichier
Cells.Clear 'on vide tes onglets
Workbooks("LabDailyTask bloc 4 N.M.xls").Activate
Sheets("Listing").Select 'on copie ton onglet
Cells.Copy
Workbooks("LabDailyTaskbloc4compile.xls").Activate
Cells.Paste 'on le colle dans ton nouveau fichier
Else
i = 1 'on balaie ta première colonne
Do While Cells(i, 1) <> "" 'on va rechercher la dernière ligne de ta première colonne bref jusqu'à ce qu'il n'y ait rien
i = i + 1
Loop
Workbooks("LabDailyTask S.P.xls").Activate 'on va faire de même dans ton deuxième fichier
j = 1
Do While Cells(j, 1) <> "" 'on va rechercher la dernière ligne de ta première colonne bref jusqu'à ce qu'il n'y ait rien
j = j + 1
Loop
Range(Rows(2), Rows(j)).Copy
Workbooks("LabDailyTaskbloc4compile.xls").Select
Rows(i).Select
ActiveSheet.Paste
Cells(1, 1).Select
End If
Next Onglets
Workbooks(fichier).Close
Next a
End Sub
Par contre je ne souhaite copier qu'un seul onglet de mes 2 fichiers, l'onglet listing
Pourrais-tu m'aider stp?
Merci
-
-
Merci beaucoup pour ton aide, je le mets en pratique demain pour voir si ca marche!
-
