Copie coller les cellules vides avec celle du dessus [Résolu/Fermé]

namy89 6 Messages postés vendredi 1 avril 2016Date d'inscription 24 novembre 2016 Dernière intervention - 22 nov. 2016 à 12:19 - Dernière réponse : namy89 6 Messages postés vendredi 1 avril 2016Date d'inscription 24 novembre 2016 Dernière intervention
- 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


Afficher la suite 
6Messages postés vendredi 1 avril 2016Date d'inscription 24 novembre 2016 Dernière intervention

4 réponses

Patrice33740 6316 Messages postés dimanche 13 juin 2010Date d'inscription 11 décembre 2017 Dernière intervention - 23 nov. 2016 à 14:27
+1
Utile
3
Bonjour,

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

Cette réponse vous a-t-elle aidé ?  
namy89 6 Messages postés vendredi 1 avril 2016Date d'inscription 24 novembre 2016 Dernière intervention - 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é"
Patrice33740 6316 Messages postés dimanche 13 juin 2010Date d'inscription 11 décembre 2017 Dernière intervention - 23 nov. 2016 à 23:39
Dsl, avec :
Set DESTIN = DEST.Resize(PL.Columns.Count, 1).Offset(0, 31)
namy89 6 Messages postés vendredi 1 avril 2016Date d'inscription 24 novembre 2016 Dernière intervention - 24 nov. 2016 à 16:21
ça marche. Je vous remercie.