Bonjour,

J'aurais besoin de votre aide.
Je suis entrain de regrouper plusieurs base pour former une seule base de donnée. Chaque base correspond à un fichier excel qui appartient à un seul sujet (tous ont les mêmes variables). J'ai réussi à copier chaque base de chaque fichier excel et coller dans un seul fichier les uns sur les autres pour former une seule base.
Maintenant je voudrais copier l'identifiant du sujet qui est dans une cellule et qui est la même pour toutes les bases et coller à la dernière colonne vide (ou une colonne vide que je peux identifier dès le départ) de la base finale. J'ai réussi à le faire mais en collant l'identifiant sur une seule ligne. Or, j'aimerai que ça soit répété pour toutes les lignes lui appartenant.

J'espère que tout est claire.
Je vous remercie pour votre aide

Ci dessous mon programme :


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
Sub Macro1()
Dim CC As Workbook 'déclare la variable CC (Classeur Cible)
Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)
Dim F As String 'déclare la variable F (Fichiers)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CO As Range
 
 
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim DESTIN As Range
 
Set CC = ThisWorkbook 'définit le classeur cible CC
Set OC = CC.Sheets("Feuil1") 'définit l'onglet cible OC (à adapter)
F = Dir(CC.Path & "\*.xls?") 'définit le fichier F (premier fichier Excel du dossier contenant ce classeur)
Do While F <> "" 'boucle tant qu'il existe des fichiers
    If Not F = CC.Name Then 'condition : si F n'est pas ce classeur
        Workbooks.Open (F) 'ouvre le fichier F
        Set CS = ActiveWorkbook 'définit le classeur source CS
        Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS (à adapter)
        Set PL = OS.Range("D10:S39") 'définit la plage PL (à adapter, peut aussi être PL=OS.Rows(1))
        Set CO = OS.Range("D3")
        'définit la cellule de destination DEST (A1 si A1 est vide,
        'sinon la première cellule vide de la colonne 1 (=A) de l'onglet cible OC (à adapter)
        Set DEST = IIf(OC.Range("A1").Value = "", OC.Range("A1"), OC.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))   'DEST = Application.Transpose(PL)
        PL.Copy
        DEST.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
        'mnt je cherche l'identifiant et je vais la coller sur la colonne AF1de la base finale
        Set DESTIN = IIf(OC.Range("AF1").Value = "", OC.Range("AF1"), OC.Cells(Application.Rows.Count, 32).End(xlUp).Offset(1, 0))
        CO.Copy DESTIN 
 
        'j'aimerais donc ici pouvoir prolonger la copie de l'identifiant sur les autres lignes de la base avant de fermer et aller dans une autre base
 
 
 
        CS.Close 'ferme le classeur source
    End If 'fin de la condition
    F = Dir 'redéfinit le fichier F (prochain fichier Excel du dossier contenant ce classeur)
Loop 'boucle
End Sub