Copie coller les cellules vides avec celle du dessus

Résolu/Fermé
namy89 Messages postés 6 Date d'inscription vendredi 1 avril 2016 Statut Membre Dernière intervention 24 novembre 2016 - 22 nov. 2016 à 12:19
namy89 Messages postés 6 Date d'inscription vendredi 1 avril 2016 Statut Membre Dernière intervention 24 novembre 2016 - 24 nov. 2016 à 16:21
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 :


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


A voir également:

1 réponse

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
23 nov. 2016 à 14:27
Bonjour,

Avec :
        Set DESTIN = Intersect(DEST.EntireRow, CO.Columns("AF"))

1
namy89 Messages postés 6 Date d'inscription vendredi 1 avril 2016 Statut Membre Dernière intervention 24 novembre 2016
23 nov. 2016 à 20:44
Merci pour votre réponse.
Malheureusement cela ne fonctionne pas. ça affiche "Erreur d'exécution '1004' La méthode 'Intersect' de l'objet '_Global' a échoué"
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
23 nov. 2016 à 23:39
Dsl, avec :
Set DESTIN = DEST.Resize(PL.Columns.Count, 1).Offset(0, 31)
0
namy89 Messages postés 6 Date d'inscription vendredi 1 avril 2016 Statut Membre Dernière intervention 24 novembre 2016
24 nov. 2016 à 16:21
ça marche. Je vous remercie.
0