Copier une selection de cellule depuis plusieurs classeur EXCEL

[Fermé]
Signaler
Messages postés
10
Date d'inscription
mercredi 21 novembre 2012
Statut
Membre
Dernière intervention
17 novembre 2015
-
Messages postés
10
Date d'inscription
mercredi 21 novembre 2012
Statut
Membre
Dernière intervention
17 novembre 2015
-
Bonjour,

Je souhaite récupérer grâce une Macro le contenu d'une selection de cellule à partir de plusieurs classeur Excel. Les fichiers Excel se trouve dans le même dossier Exemple:

Feuil classeur A:
Produit A Produit B Produit C
AA AC AT
AB AF AZ
AA AH AX
Feuil classeur B:
Produit A Produit B Produit C
BB AC AT
AB AF AZ
AA AH AX
CC
ZZ
Feuil classeur C:
Produit A Produit B Produit C
AA AC AT
AB AF AZ
AA AH AX
DD EE FF
XX
FF
HH
Résultat voulu:
Classeur D, Feuil Recap:
Produit A Produit B Produit C
AA AC AT
AB AF AZ
AA AH AX
BB AC AT
AB AF AZ
AA AH AX
CC
ZZ
AA AC AT
AB AF AZ
AA AH AX
DD EE FF
XX
FF
HH

Je vous remercie de votre.

2 réponses

Messages postés
15979
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 septembre 2021
1 535
Bonjour,

Les fichiers Excel se trouve dans le même dossier Oui, mais y a t-il un ordre dans la copie des fichiers, A et B "facile", mais avec les noms de fichiers ????
Messages postés
15979
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 septembre 2021
1 535 >
Messages postés
10
Date d'inscription
mercredi 21 novembre 2012
Statut
Membre
Dernière intervention
17 novembre 2015

Re,

Ok, je vois ca demain

A+
Messages postés
1429
Date d'inscription
lundi 13 juillet 2009
Statut
Membre
Dernière intervention
8 juin 2021
482
Ce sujet a déjà été traité ici :
www.commentcamarche.net/forum/affich-32659234-macro-copier-coller-des-lignes-d-un-tableau

C'est strictement le même sujet mais avec des classeurs différents.
Une adapation de la macro est largement suffisant pour obtenir le résultat.
Messages postés
15979
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 septembre 2021
1 535 >
Messages postés
1429
Date d'inscription
lundi 13 juillet 2009
Statut
Membre
Dernière intervention
8 juin 2021

Bonjour,

Ok, j'attends pour continuer

Bonjour,
La récupération des données dans l'exemple que tu proposes est faite sur plusieurs onglets d'un même classeur. Dans mon besoin, les données ont la même structure avec un nombre de ligne variable et positionnées dans plusieurs classeurs d'un même dossier.
Merci pour votre aide.
Messages postés
15979
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 septembre 2021
1 535 > heisenberg007
Bonjour,

ozone_ - 19 oct. 2015 à 20:38 a ecrit:
C'est strictement le même sujet mais avec des classeurs différents.
Une adapation de la macro est largement suffisant pour obtenir le résultat.


Pouvez-vous faire cette adaptation ou pas ???
Messages postés
1429
Date d'inscription
lundi 13 juillet 2009
Statut
Membre
Dernière intervention
8 juin 2021
482
Voilà ce que j'ai pu faire :

Sub CumulDonnee()

    ' Déclaration des variables
    Dim i, j, k, l, m, n As Integer: i = 1
    Dim classeur_1, classeur_2, classeur_3 As Workbook

    ' Attribut les noms des classeurs et le chemin (ici le même dossier que le classeur qui compile les données)
    Set ClasseurSource = ActiveWorkbook
    Set classeur_1 = Workbooks.Open("Classeur1.xlsx")
    Set classeur_2 = Workbooks.Open("Classeur2.xlsx")
    Set classeur_3 = Workbooks.Open("Classeur3.xlsx")
    
    Application.ScreenUpdating = False
    
    ' Traite les lignes à copier du classeur_1 - 500 lignes de A500 à C500
    ' Commence à la ligne 2 (On ne prend pas en compte les en-tête des tableaux du classeur_1)
    For k = 2 To 500
        If classeur_1.Sheets("Feuil1").Cells([k], 1) <> "" Or classeur_1.Sheets("Feuil1").Cells([k], 2) <> "" Or classeur_1.Sheets("Feuil1").Cells([k], 3) <> "" Then
            classeur_1.Sheets("Feuil1").Range("A" & k & ":C" & k).Copy
            ClasseurSource.Sheets("Données compilées").Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
            i = i + 1
        End If
    Next
    
    ' Traite les lignes à copier du classeur_2 - 500 lignes de A500 à C500
    ' Commence à la ligne 2 (On ne prend pas en compte les en-tête des tableaux du classeur_2)
    For k = 2 To 500
        If classeur_2.Sheets("Feuil1").Cells([k], 1) <> "" Or classeur_2.Sheets("Feuil1").Cells([k], 2) <> "" Or classeur_2.Sheets("Feuil1").Cells([k], 3) <> "" Then
            classeur_2.Sheets("Feuil1").Range("A" & k & ":C" & k).Copy
            ClasseurSource.Sheets("Données compilées").Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
            i = i + 1
        End If
    Next
 
    ' Traite les lignes à copier du classeur_3 - 500 lignes de A500 à C500
    ' Commence à la ligne 2 (On ne prend pas en compte les en-tête des tableaux du classeur_3)
    For k = 2 To 500
        If classeur_3.Sheets("Feuil1").Cells([k], 1) <> "" Or classeur_3.Sheets("Feuil1").Cells([k], 2) <> "" Or classeur_3.Sheets("Feuil1").Cells([k], 3) <> "" Then
            classeur_3.Sheets("Feuil1").Range("A" & k & ":C" & k).Copy
            ClasseurSource.Sheets("Données compilées").Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
            i = i + 1
        End If
    Next
    
    Application.ScreenUpdating = True
 
    ' Fermeture des classeurs
    classeur_1.Close
    classeur_2.Close
    classeur_3.Close
    
End Sub



Les classeurs tests sont disponible ici :
https://www.cjoint.com/c/EJvtLqvtEOB

A voir si cela convient !

Bonjour,

ça convient parfaitement ! Je te remercie pour ton aide et pour ta réactivité. Bon courage
Messages postés
10
Date d'inscription
mercredi 21 novembre 2012
Statut
Membre
Dernière intervention
17 novembre 2015

Une dernière question :)
J'essaye de refaire la même chose mais cette fois avec une boucle qui parcours tout les fichiers d'un dossier. Dans mon exemple j'ai mentionné 3 classeurs mais mon cas concernent beaucoup de classeurs.

J'ai essayé cela, mais j'ai des erreurs à la compilation.
Merci pour votre aide.


Sub CumulDonnee()

' Déclaration des variables
Dim i, j, k, l, m, n As Integer: i = 1
Dim wb As Workbook


Chemin = "C:\Users\PYMI06881\Desktop\test\"

Fichier = Dir(Chemin & "*.xls")

Set ClasseurSource = ActiveWorkbook

' Attribut les noms des classeurs et le chemin (ici le même dossier que le classeur qui compile les données)
'Set ClasseurSource = ActiveWorkbook
'Set wb = Workbooks.Open(Path & "C1.xlsx")


Application.ScreenUpdating = False

Do While Fichier <> Chemin & "Compilation.xls"

Set wb = Workbooks.Open(Chemin & Fichier)

' Traite les lignes à copier du wb - 500 lignes de A500 à C500
' Commence à la ligne 2 (On ne prend pas en compte les en-tête des tableaux du wb)
For k = 2 To 500

'wb = Workbooks.Open(Fichier)

If wb.Sheets("Feuil1").Cells([k], 1) <> "" Or wb.Sheets("Feuil1").Cells([k], 2) <> "" Or wb.Sheets("Feuil1").Cells([k], 3) <> "" Then
With wb
.Sheets("Feuil1").Range("A" & k & ":J" & k).Copy
End With
With ClasseurSource.Sheets("Données compilées")
.Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
i = i + 1
End With
End If

' Fermeture des classeurs
wb.Close True
Set wb = Nothing

Fichier = Dir

Next

Loop

Application.ScreenUpdating = True


End Sub

Messages postés
1429
Date d'inscription
lundi 13 juillet 2009
Statut
Membre
Dernière intervention
8 juin 2021
482
Je suis pas en mesure de tester le code que j'ai créer pour le moment mais j'ai tenter quelque chose quand même, si ça marche tant mieux sinon je le reverrais un peu plus tard !
Ou en attente d'un autre contributeur fan d'Excel !

Sub CumulDonnee()

    ' Déclaration des variables
    Dim i, k As Integer: i = 1
    Dim wb, ClasseurSource As Workbook
    Dim Chemin As String
    
    ' Attribut
    Chemin = "C:\Users\PYMI06881\Desktop\test\"
    Fichier = Dir(Chemin)
    Set ClasseurSource = ActiveWorkbook
    
    Application.ScreenUpdating = False
    
    Do While Fichier <> "Compilation.xls"

        Set wb = Workbooks.Open(Fichier)
    
        ' Traite les lignes à copier du wb - 500 lignes de A500 à C500
        ' Commence à la ligne 2 (On ne prend pas en compte les en-tête des tableaux du wb)
        For k = 2 To 500
        
            If wb.Sheets("Feuil1").Cells([k], 1) <> "" Or wb.Sheets("Feuil1").Cells([k], 2) <> "" Or wb.Sheets("Feuil1").Cells([k], 3) <> "" Then
                wb.Sheets("Feuil1").Range("A" & k & ":J" & k).Copy
                ClasseurSource.Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                i = i + 1
            End If
            
            ' Fermeture des classeurs
            wb.Close True
            Set wb = Nothing
            
        Next
       
        Fichier = Dir
    
    Loop
    
    Application.ScreenUpdating = True
 
End Sub
Messages postés
10
Date d'inscription
mercredi 21 novembre 2012
Statut
Membre
Dernière intervention
17 novembre 2015

Bonjour,

Je relance ce poste ouvert il y a quelques semaines.
@ozone : Je te remercie pour ta réponse.Lors de la compilation le programme bloque au niveau du " Set wb = Workbooks.Open(Fichier) "
Peux-tu revoir cela ?
Merci pour ton aide.