Copie de cellules de 3 classeurs différents vers un même classeur

[samanthasauvestre]

Bonjour à tous,

Je suis nouvelle sur le forum et novice sur EXcel =).
Je crée cette nouvelle discussion car je n'ai pas trouver de réponse à ma question jusqu'à présent.
Je vais essayer de vous expliquer mon problème.

J'ai 3 tableaux "classeur1 à classeur 3" qui chacun ont une ou plusieurs feuilles.
Chacun de ces tableaux sont alimentés chaque jour.

J'ai besoin de créer un tableau récapitulatif dans lequel serait copiées en automatique certaines cellules des ces trois tableaux, et de chacune des feuilles.
Cependant, je ne veux pas copier toutes les cellules des tableaux, ni toutes les lignes...

Je m'explique avec mon exemple:
- CLASSEUR 1: copier automatiquement la case Projet1, date 1; date 2 et lien hypertxt doc1
+ copier automatiquement la case projet 2, date 1, date 2, lien hypertxt doc 1
et ceux de façon identique si des projet 3, 4 ... sont ajoutés sur chacune des feuilles.
Ce qui complique encore plus l'affaire c'est qu'il est possible pour chaque utilisateur d'ajouter des lignes entre chaque projet et qu'il est impossible de savoir combien de ligne on aura entre projet 1 et Projet 2...

Idem pour le classeur 2 et 3, qui eux aussi ont les meme cellules a copier dans le tableau récapitulatif.

Je ne sais pas si j'ai été très claire, j'imagine que vous aurez plus amples questions^^

Merci d'avance pour vos réponses

 

[Robert]

Re : Copie de cellules de 3 classeurs différents vers un même classeur

Bonjour Samantha, bonjour le forum,

Si les fichiers se trouvent dans le même dossier que le fichier Recap, le code commenté ci-dessous devrait convenir. Il doit être placé dans le fichier Recap qui prend donc l'extension xlsm...

Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DEStination)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
CH = ThisWorkbook.Path & "\" 'définit le chemin d'accès CH
Set OD = CD.Sheets("Feuil1") 'définit l'onglet de destination OD
F = Dir(CH & "Classeur*.xlsx") 'définit le premier fichier F dans le dossier CH
Do While F <> "" 'boucle tant qu'il existe des fichier dans le dossier CH
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set CS = Workbooks(F) 'définit le classeur source (génere une erreur si le classeur n'est pas ouvert)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Workbooks.Open (F) 'ouvre la classeur F
        Set CS = ActiveWorkbook 'définit le classeur source CS
        Err = 0 'annule l'erreur
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    For Each O In CS.Sheets 'boucle sur tous les onglets O du classeur source CS
        O.Select 'sélectionne l'onglet
        DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
        If O.Range("A5").Value <> "" Then 'condition : si la cellule A5 de l'onglet O n'est pas vide
            O.Range("A5").Select 'sélectionne la cellule A5 de l'onglet O
            Do While ActiveCell.Row <= DL 'boucle tabt que la ligne de la cellule active est inférieure ou égale à DL
                Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST dans l'onglet de destination OD
                DEST.Value = ActiveCell.Value 'renvoie le nom du projet
                DEST.Offset(0, 1).Value = ActiveCell.Offset(0, 2).Value 'renvoie la date 1
                DEST.Offset(0, 2).Value = ActiveCell.Offset(0, 3).Value 'renvoie la date 2
                DEST.Offset(0, 3).Value = ActiveCell.Offset(0, 4).Value 'renvoie le lien1
                DEST.Offset(0, 4).Value = ActiveCell.Offset(0, 5).Value 'renvoie le lien2
                ActiveCell.End(xlDown).End(xlDown).Select 'sélectionne deux fois la dernière cellule éditée en dessous de la cellule active
            Loop 'boucle
        End If 'fin de la condition
    Next O 'prochain onglet de la boucle
    CS.Close False 'ferme le classeur source CS
    F = Dir 'redéfinit le fichier F (fichier suivant)
Loop 'boucle
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
End Sub

Le fichier :

 

[samanthasauvestre]

Re : Copie de cellules de 3 classeurs différents vers un même classeur

Bonjour Robert,

Merci pour votre réponse.
Je ne comprend pas trop où je dois écrire cette formule savante ^^
Pensez vous qu'avec cela, si une personne écrit dans le classeur1 et qu'une second personne écrit dans le classeur2; on aura dans le doc récap les éléments de chacun des classeurs?
Est il possible également que dans les classeurs 1 2 et 3, je puisse anticiper le fait de copier dans le doc recap uniquement les cellules pour les projets (cad en bleu dans mes docs)?
Cependant, chacun des fichiers excel sont situés sous un même réseau mais dans des dossiers séparés.


Je ne sais pas si cela est possible t si je suis claire.

Merci d'avance pour votre aide.

 

[samanthasauvestre]

Re : Copie de cellules de 3 classeurs différents vers un même classeur

Bonjour à tous, Bonjour Robert,

Je n'ai pas réussi à entrer la formule dans le doc, je débute la dedans.

Pouvez vous m'en dire plus?
Merci de votre aide.

Samantha