Boucle copier coller avec décalage

Didou59 · 23 Octobre 2012

Bonjour à toutes et à tous,
Nouveau sur ce forum, fort intéressant, je commence à essayer de comprendre le VBA. J'ai aujourdh'ui besoin de votre aide pour réaliser un copier coller en boucle avec un décalage automatique d'une ligne. Je m'explique : dans le fichier joint, j'ai une feuille "titularisation" qui sera remplie par des communes. Je veux qu'à partir de cette feuille des valeurs soient copiée sur la feuille "edition". Jusque là pas trop de problème. Ces valeurs vont se copier à partir (par exemple) de la cellule A60. Le souci c'est qu'il y aura encore des éléments sur la feuille édition qui devront se décaler vers le bas au fur et à mesure. Vous trouverz un premier code écris qui copie colle avec une boucle. Je ne suis pas certains de ce code. Pouvez vous m'aider. Mon objectif n'est bien évidemment pas d'obtenir du clé en main mais bien au contraire d'essayer de comprendre puis d'utiliser le vba.
D'avance merci pour vos réponses. N'arrivant pas à joindre mon fichier (trop gros et apparemment je ne peux pas ajouter de fihcier zippé avec 7zip), je vous ai copié la macro ci-dessous :
Sub Copier()
For i = 1 To 250
Sheets("Titularisation").Select
Range("K16:K2000").Copy
Sheets("Edition").Select
Range("A60").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Sheets("Titularisation").Select
Range("M16:M2000").Copy
Sheets("Edition").Select
Range("B60").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Sheets("Titularisation").Select
Range("L16:L2000").Copy
Sheets("Edition").Select
Range("C60").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Sheets("Titularisation").Select
Range("AE16:AG2000").Copy
Sheets("Edition").Select
Range("D60").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
ActiveCell.Offset(0, 1).Select
Next i
End Sub

Didou59 · 24 Octobre 2012

Re : Boucle copier coller avec décalage

Modeste,
Je te mets en pièce jointe le fichier tel qu'il serait finalisé (ou à peu près). Je ne dois pas collé en ligne 10 mais en ligne 52 ou 53 . J'ai modifié moi-même les numéros de ligne dans la macro mais cela ne me donne pas le résultat escompté. En ce qui concerne la suppression des lignes, est-il possible de ne supprimer que les lignes qui ont été collées une première fois ? En tous les cas je te tire mon chapeau pour le travail réalisé qui devrait correspondre à mes attentes avec quelques petites modifications du genre ne pas copier les colonnes AE à AG mais les colonnes AV et Bf (ce que je pense être capable de faire).

Didou59 · 25 Octobre 2012

Re : Boucle copier coller avec décalage

Bonjour Modeste,
Afin de mieux présenter mes pages pour mes différents interlocuteurs, il me faudrait éventuellement fusionner des cellules dans la feuille "Edition". Peux-tu me dire si cette macro est correcte sachant qu'il faudrait l'adapter pour que l'on ne fusionne les cellules qu'après le copier coller de la première macro (ex : la copie du grade se ferait sur les cellules C et D dans la feuille édition).

Code:

Sub Fusion_de_cellules()

    Range("D57:E57").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
End Sub

Modeste · 25 Octobre 2012

Re : Boucle copier coller avec décalage

Bonjour,

Je n'arrive pas à suivre, à ce rythme-là 🙄
- Dans ton avant-dernier message, tu parles de coller dans les lignes 52 ou 53 ... ben 'faut choisir, à un moment ou l'autre ... (et pourquoi 52 ou 53, alors que tes titres sont en ligne 49?)
- Il faudra aussi que tu expliques ce que tu entends par "ne supprimer que les lignes qui ont été collées une première fois"
- Dans ton dernier message, tu parles de fusionner ... mais il s'agit de deux cellules voisines ... alors pourquoi ne pas "centrer sur plusieurs colonnes"? Les fusions en Excel (comme en macro-économie 🙄) posent plus de problèmes qu'autre chose!

Didou59 · 25 Octobre 2012

Re : Boucle copier coller avec décalage

Modeste,
Je te prie de m'excuser pour ma rapidité décriture de message et donc de ne pas attendre tes réponses. Pour la ligne 52 ou 53, effectivement je voudrais coller juste en dessous de la ligne d'en-tête mais qui sera peut-être déplacée lors de la mise en forme finale du document. Pour la suppression des lignes je n'emploie peut-être pas le bon langage, comme expliqué dans un message précédent, je placerais un bouton sur la feuille "Titularisation" qui s'appellera "Créer le rapport", mon objectif étant que si le quidam qui a saisi a fait une erreur et s'en rend compte après avoir cliquer sur le bouton un nouveau click doit permettre "d'effacer le premier" et de remplacer par le deuxième (si je m'exprime correctement). En ce qui concerne la fusion, j'ai effectivement balayé le net à ce sujet et beaucoup sont d'accord avec toi. Dans ce cas est-il possible de centrer sur 2 voire 3 colonnes (ne sais pas encore) via la macro ?
Pour ton information je suis en week-end ce soir et reprend lundi. Je ne pourrais donc pas tester d'ici là.
Encore un grand merci pour ton aide.

Modeste · 25 Octobre 2012

Re : Boucle copier coller avec décalage

Re,

Ma foi, si tu pars en week-end, me voilà en congé aussi 😉
Avant de partir, tu veux bien aussi relire mon message #15 ... j'y posais une ou deux questions, liées à la suppression des dernières lignes insérées!
Quant au choix de la ligne 52 ou 53 et au "décalage" des titres, c'est important (pour le tri: les données ont des en-têtes ... ou pas?)

Bon week-end,

Didou59 · 25 Octobre 2012

Re : Boucle copier coller avec décalage

Modeste,
Effectivement les données collées auront une ligne d'en-têtes, on colle donc juste à la ligne dessous. En ce qui concerne les données en dessous du collage il y en aura. C'est pourquoi je m'interrogeais sur le fait qu'avec le bouton créé pour la macro si il était possible en cliquant dessus une deuxième voire troisième ... fois cela pouvait "annuler" le click précédent qui serait remplacer par le dernier click (j'en demande peut-être beucoup !).
Bon week-end à toi et encore un grand merci.
J'espère pouvoir comprendre correctement tes instructions pour évoluer en VBA.

Modeste · 25 Octobre 2012

Re : Boucle copier coller avec décalage

Bonsoir (si tu n'es pas encore parti)
Bonjour (si tu me lis à ton retour)

Cette version colle les données en ligne 50 et suivantes. J'ai dû défusionner les cellules de titres (lignes 48 et 49), sinon problème avec le tri. On verra quel système utiliser, si une date doit être encodée en E49.
La suppression des "anciennes" lignes est prise en charge (en espérant que l'hypothèse "pas de cellules vides en colonne A de la feuille Edition" est correcte ... cfr message #15 🙄)

Je ne le dis plus: bon week-end (ou bon retour)

Didou59 · 29 Octobre 2012

Re : Boucle copier coller avec décalage

Bonjour Modeste,
Je te remercie pour le dernier envoi qui fonctionne. J'ai quand même des petits points de mise en forme (j'ai tenté de mon coté mais n'y suis pas arrivé). Si on fait le test avec des grades différents, la ligne ""Nombre d'agents remplissant les conditions par grade" ne s'affiche pas sur les colonnes A à D mais uniquement dans la colonne A. Est-il possible d'encadrer les cellules A à D, la cellule E et de metrre en police 8 ? Pour ton info, j'ai juste modifié les infos que je devais ramener dans mon tableau et l'affichage du comptage que je place en colonne E et non plus D.
Merci beaucoup.

Modeste · 29 Octobre 2012

Re : Boucle copier coller avec décalage

Bonsoir,

le dernier envoi qui fonctionne

... Il fonctionne, certes, mais il y manquait quelques '.' dans les instructions With et certaines lignes étaient insérées dans la mauvaise feuille. Pour le reste, je ne suis pas certain d'avoir tout compris ... voilà donc ce que j'ai fait (ajouté en fin de code)
- bordures fines à toute la plage
- renvoi du texte à la ligne, de manière qu'il ne "déborde" pas dans les colonnes voisines
- (en conséquence) ajustement automatique des hauteurs de lignes
- taille de police fixée à 8 pour toute la plage aussi

... tu garderas ce qui te convient (ou on modifiera si nécessaire 🙄)

Didou59 · 30 Octobre 2012

Re : Boucle copier coller avec décalage

Bonjour Modeste,
Merci pour cette version qui fonctionne. Dernière (je pense) petite question : est-il possible de centrer sur plusieurs colonnes (de A à D) le contenu de la celuule A qui reprend "Nombre d'agents remplissant les conditions par grade" et j'afficherai le total dans la colonne E. Je te met le code que j'ai quelque peu modifier pour arriver à la présentation désirée afin que tu comprennes ce que je veux dire :

D'avance un grand merci.

Code:

Sub copie()
Application.ScreenUpdating = False

' *** Effacer les lignes précédentes
With Sheets("Edition")
    If .Range("A50") <> "" Then
        .Range("A50:A" & .Range("A50").End(xlDown).Row).EntireRow.Delete
        Range("A51").EntireRow.Copy 'récupérer une ligne "perdue" lors de l'affichage des sous-totaux
        Range("A51").Insert shift:=xlDown
    End If
    Application.CutCopyMode = False
End With

With Sheets("Titularisation")
nblig = Application.CountA(.Range("G15:G10000")) - 1 'combien de lignes à insérer? (sur base des noms en colonne G)
Sheets("Edition").Range("51:" & 51 + nblig).Insert 'insertion des lignes
    For Each c In .Range("G15:G" & 15 + nblig) 'pour chaque cellule de la plage
        .Range("K" & c.Row).Copy
            Sheets("Edition").Range("A" & 50 + lig).PasteSpecial Paste:=xlValues 'coller les valeurs (sinon formules en erreur)
            Sheets("Edition").Range("A" & 50 + lig).PasteSpecial Paste:=xlPasteFormats 'coller le format
        .Range("M" & c.Row).Copy
            Sheets("Edition").Range("B" & 50 + lig).PasteSpecial Paste:=xlValues
            Sheets("Edition").Range("B" & 50 + lig).PasteSpecial Paste:=xlPasteFormats
        .Range("L" & c.Row).Copy
            Sheets("Edition").Range("C" & 50 + lig).PasteSpecial Paste:=xlValues
            Sheets("Edition").Range("C" & 50 + lig).PasteSpecial Paste:=xlPasteFormats
        .Range("AW" & c.Row).Copy
            Sheets("Edition").Range("D" & 50 + lig).PasteSpecial Paste:=xlValues
            Sheets("Edition").Range("D" & 50 + lig).PasteSpecial Paste:=xlPasteFormats
        .Range("BD" & c.Row).Copy
            Sheets("Edition").Range("E" & 50 + lig).PasteSpecial Paste:=xlValues
            Sheets("Edition").Range("E" & 50 + lig).PasteSpecial Paste:=xlPasteFormats
        lig = lig + 1
    Next c
End With
Application.CutCopyMode = False
' *** Tri sur 3 clés
With Sheets("Edition")
    .Range("A50").CurrentRegion.Sort key1:=.Range("A51"), order1:=xlAscending, _
        key2:=.Range("B51"), order2:=xlAscending, key3:=.Range("C51"), order3:=xlAscending, Header:=xlYes
' *** Insertion lignes pour sous-totaux
    cpt = 1
    .Range("A" & 51 + nblig) = "Nombre d'agents remplissant les conditions par grade" 'dernier sous-total
    .Range("A" & 51 + nblig).Resize(1, 5).Interior.Color = RGB(210, 210, 210) 'plage en gris
    .Range("A" & 51 + nblig).Resize(1, 4).HorizontalAlignment = xlCenterAcrossSelection
    .Range("A" & 51 + nblig).Resize(1, 4).VerticalAlignment = xlCenter
    .Range("A" & 51 + nblig).Resize(1, 4).WrapText = False
    .Range("A" & 51 + nblig).Resize(1, 4).Orientation = 0
    .Range("A" & 51 + nblig).Resize(1, 4).AddIndent = False
    .Range("A" & 51 + nblig).Resize(1, 4).IndentLevel = 0
    .Range("A" & 51 + nblig).Resize(1, 4).ShrinkToFit = False
    .Range("A" & 51 + nblig).Resize(1, 4).ReadingOrder = xlContext
    .Range("A" & 51 + nblig).Resize(1, 4).MergeCells = False
    For g = 50 + nblig To 51 Step -1 'pour insérer des lignes, on commence par la fin du tableau
        If .Range("C" & g) <> .Range("C" & g - 1) Then 'si le grade est différent de celui au-dessus
            Rows(g).Insert shift:=xlDown 'on insère une ligne
            .Range("A" & g) = "Nombre d'agents remplissant les conditions par grade"
            .Range("A" & g).Resize(1, 5).Interior.Color = RGB(210, 210, 210)
            .Range("A" & 51 + nblig).Resize(1, 4).HorizontalAlignment = xlCenterAcrossSelection
            .Range("A" & 51 + nblig).Resize(1, 4).VerticalAlignment = xlCenter
            .Range("A" & 51 + nblig).Resize(1, 4).WrapText = False
            .Range("A" & 51 + nblig).Resize(1, 4).Orientation = 0
            .Range("A" & 51 + nblig).Resize(1, 4).AddIndent = False
            .Range("A" & 51 + nblig).Resize(1, 4).IndentLevel = 0
            .Range("A" & 51 + nblig).Resize(1, 4).ShrinkToFit = False
            .Range("A" & 51 + nblig).Resize(1, 4).ReadingOrder = xlContext
            .Range("A" & 51 + nblig).Resize(1, 4).MergeCells = False
            cpt = cpt + 1 'compteur de lignes insérées
        End If
    Next g
' *** calculs des sous-totaux
    For n = 50 To (50 + nblig + cpt) ' de la ligne 50 à la ligne correspondant à 50 +nbre de lignes copiées + nbre de lignes de sous-totaux
        nb = nb + 1 'compteur de grades
        If .Range("A" & n) = "Nombre d'agents remplissant les conditions par grade" Then 'si on est en ligne de sous-total
            .Range("E" & n) = nb - 1
            nb = 0
        End If
    Next n
    With .Range("A50:E" & 50 + nblig + cpt)
        .Borders.LineStyle = xlContinuous
        .Font.Size = 8
        .WrapText = True
        .EntireRow.AutoFit
    End With
End With

End Sub

Modeste · 30 Octobre 2012

Re : Boucle copier coller avec décalage

Bonjour,

Si j'ai bien compris, il suffit:
- de supprimer (dans mes derniers ajouts) les deux lignes suivantes:

Code:

.WrapText = True
.EntireRow.AutoFit

- à l'endroit où tu précises que le sous-total doit figurer en colonne E, ajouter:

Code:

.Range("A" & n).Resize(1, 4).HorizontalAlignment = xlCenterAcrossSelection

... Si c'est vraiment ce que tu veux 😉

Didou59 · 30 Octobre 2012

Re : Boucle copier coller avec décalage

Modeste,
Je viens de tester la macro avec quelques petites modifications et cela fonctionne à merveille. Je te mets ci-dessous le code final.
Je tiens à te remercier énormément pour ton travail qui va me faciliter le reste de ce que j'ai à faire. Par contre, pourrais-tu me préciser si je doit fermer la discussion et si oui quelle est la manipulation à faire.

Code:

Sub copie()
Application.ScreenUpdating = False

' *** Effacer les lignes précédentes
With Sheets("Edition")
    If .Range("A50") <> "" Then
        .Range("A50:A" & .Range("A50").End(xlDown).Row).EntireRow.Delete
        .Range("A51").EntireRow.Copy 'récupérer une ligne "perdue" lors de l'affichage des sous-totaux
        .Range("A51").Insert shift:=xlDown
    End If
    Application.CutCopyMode = False
End With

With Sheets("Titularisation")
nblig = Application.CountA(.Range("G15:G10000")) - 1 'combien de lignes à insérer? (sur base des noms en colonne G)
Sheets("Edition").Range("51:" & 51 + nblig).Insert 'insertion des lignes
    For Each c In .Range("G15:G" & 15 + nblig) 'pour chaque cellule de la plage
        .Range("K" & c.Row).Copy
            Sheets("Edition").Range("A" & 50 + lig).PasteSpecial Paste:=xlValues 'coller les valeurs (sinon formules en erreur)
            Sheets("Edition").Range("A" & 50 + lig).PasteSpecial Paste:=xlPasteFormats 'coller le format
        .Range("M" & c.Row).Copy
            Sheets("Edition").Range("B" & 50 + lig).PasteSpecial Paste:=xlValues
            Sheets("Edition").Range("B" & 50 + lig).PasteSpecial Paste:=xlPasteFormats
        .Range("L" & c.Row).Copy
            Sheets("Edition").Range("C" & 50 + lig).PasteSpecial Paste:=xlValues
            Sheets("Edition").Range("C" & 50 + lig).PasteSpecial Paste:=xlPasteFormats
        .Range("AW" & c.Row).Copy
            Sheets("Edition").Range("D" & 50 + lig).PasteSpecial Paste:=xlValues
            Sheets("Edition").Range("D" & 50 + lig).PasteSpecial Paste:=xlPasteFormats
        .Range("BD" & c.Row).Copy
            Sheets("Edition").Range("E" & 50 + lig).PasteSpecial Paste:=xlValues
            Sheets("Edition").Range("E" & 50 + lig).PasteSpecial Paste:=xlPasteFormats
        lig = lig + 1
    Next c
End With
Application.CutCopyMode = False
' *** Tri sur 3 clés
With Sheets("Edition")
    .Range("A50").CurrentRegion.Sort key1:=.Range("A51"), order1:=xlAscending, _
        key2:=.Range("B51"), order2:=xlAscending, key3:=.Range("C51"), order3:=xlAscending, Header:=xlYes
' *** Insertion lignes pour sous-totaux
    cpt = 1
    .Range("A" & 51 + nblig) = "Nombre d'agents remplissant les conditions par grade" 'dernier sous-total
    .Range("A" & 51 + nblig).Resize(1, 4).Interior.Color = RGB(210, 210, 210) 'plage en gris
    .Range("A" & 51 + nblig).Resize(1, 4).HorizontalAlignment = xlCenterAcrossSelection
    For g = 50 + nblig To 51 Step -1 'pour insérer des lignes, on commence par la fin du tableau
        If .Range("C" & g) <> .Range("C" & g - 1) Then 'si le grade est différent de celui au-dessus
            .Rows(g).Insert shift:=xlDown 'on insère une ligne
            .Range("A" & g) = "Nombre d'agents remplissant les conditions par grade"
            .Range("A" & g).Resize(1, 4).Interior.Color = RGB(210, 210, 210)
            .Range("A" & g).Resize(1, 4).HorizontalAlignment = xlCenterAcrossSelection
            cpt = cpt + 1 'compteur de lignes insérées
        End If
    Next g
' *** calculs des sous-totaux
    For n = 50 To (50 + nblig + cpt) ' de la ligne 50 à la ligne correspondant à 50 +nbre de lignes copiées + nbre de lignes de sous-totaux
        nb = nb + 1 'compteur de grades
        If .Range("A" & n) = "Nombre d'agents remplissant les conditions par grade" Then 'si on est en ligne de sous-total
            .Range("E" & n) = nb - 1
            .Range("E" & n).HorizontalAlignment = xlCenter
            .Range("E" & n).Interior.Color = RGB(210, 210, 210)
            nb = 0
        End If
    Next n
    With .Range("A50:E" & 50 + nblig + cpt)
        .Borders.LineStyle = xlContinuous
        .Font.Size = 8
        .WrapText = True
        .EntireRow.AutoFit
    End With
End With

End Sub

Modeste · 30 Octobre 2012

Re : Boucle copier coller avec décalage

Re-bonjour Didou59,

Ravi que ça te convienne 🙂

pourrais-tu me préciser si je dois fermer la discussion et si oui quelle est la manipulation à faire

On peut déjà considérer que tu viens de clôturer le sujet 😀 ... ce que certains font, c'est éditer le tout premier message de la discussion et ajouter la mention [Résolu] dans le titre

Bonne continuation à toi,

Didou59 · 31 Octobre 2012

Re : Boucle copier coller avec décalage

Bonjour Modeste,
Excuse moi mais j'ai encore une question à te poser à laquelle je n'avais pas prêté attention. J'ai rajouté une condition dans la colonne BG15 de la feuille "Titularisation". Est-il possible de ne copier les données de la feuille "Titularisation" que si cette colonne n'est pas vide ? Merci pour ton aide et cette fois ci je pense que j'en aurais terminé (après avoir testé). J'espére pouvoir un jour te rendre la pareille.

Modeste · 31 Octobre 2012

Re : Boucle copier coller avec décalage

Bonjour Didou59,

😕 Rêve-je ou y avait-il, au départ, du texte sous le tableau de la feuille "Edition" ... texte qui aurait disparu depuis? 😱 Passsskon avait quand même dû "bricoler" pour le faire descendre en insérant des lignes, puis le faire remonter, quand on "remettait à blanc". Ce texte est toujours présent dans ton "vrai" fichier?

Boucle copier coller avec décalage

Didou59

XLDnaute Nouveau

Didou59

XLDnaute Nouveau

Pièces jointes

Didou59

XLDnaute Nouveau

Modeste

XLDnaute Barbatruc

Didou59

XLDnaute Nouveau

Modeste

XLDnaute Barbatruc

Didou59

XLDnaute Nouveau

Modeste

XLDnaute Barbatruc

Pièces jointes

Didou59

XLDnaute Nouveau

Modeste

XLDnaute Barbatruc

Pièces jointes

Didou59

XLDnaute Nouveau

Modeste

XLDnaute Barbatruc

Didou59

XLDnaute Nouveau

Modeste

XLDnaute Barbatruc

Didou59

XLDnaute Nouveau

Pièces jointes

Modeste

XLDnaute Barbatruc

Discussions similaires

Boucle copier coller avec décalage

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency