Copier coller en escalier

bloublou · 23 Mai 2013

Bonjour à tous,

Je reviens vers vous concernant un copier coller en escalier.

Je voudrais copier coller une base de 20 000 lignes et que à chaque fois une les données d'une colonne à la suite viennent se rajouter à la fin. J'ai 40 colonnes comme ca à copier coller, au lieu de les faire à la main est-ce que vous voyez une astuce sous VBA ? 😕

Egalement si je veux faire ce copier coller que pour les colonnes de chiffres de CJ à DD, comment puis-je faire bu que les colonnes ne suivent pas la base en vert ?

Je vous mets le fichier en PJ qui sera plus parlant.🙂

Merci beaucoup de votre aide,

BlouBlou

ROGER2327 · 24 Mai 2013

Re : Copier coller en escalier

Bonsoir bloublou

Un essai pour le premier problème.

VB:

Sub toto()
Dim rngBas As Range, rngRes As Range
Dim oCom&, oCol&, oBloc&
Dim i&

    Set rngBas = ThisWorkbook.Worksheets("Base").Range("A1")
    Set rngRes = ThisWorkbook.Worksheets("Résultat").Range("A1")
    oCom = 66
    oCol = 42
    oBloc = 9

    rngBas.Resize(1, oCom).Copy Destination:=rngRes

    For i = 0 To oCol - 1
        rngBas.Resize(oBloc, oCom).Offset(1).Copy Destination:=rngRes.Offset(1 + oBloc * i)
        rngBas.Resize(oBloc, 1).Offset(1, oCom + i).Copy Destination:=rngRes.Offset(1 + oBloc * i, oCom)
    Next

    rngRes.Parent.Cells.EntireColumn.AutoFit

End Sub

C'est brut de fonderie, testé sur l'exemple. Pas testé avec des blocs de vingt mille lignes...

Pour la suite :

bloublou à dit:
(...)
Egalement si je veux faire ce copier coller que pour les colonnes de chiffres de CJ à DD, comment puis-je faire bu que les colonnes ne suivent pas la base en vert ?
(...)

je ne comprends pas.

Bonne nuit.

ROGER2327
#6650

Vendredi 6 Merdre 140 (Saint Cucufat, mécène - fête Suprême Quarte)
4 Prairial An CCXXI, 9,4190h - angélique
2013-W21-4T22:36:20Z

bloublou · 24 Mai 2013

Re : Copier coller en escalier

Bonjour ROGER2327,

Merci pour ton aide, cela marche bien sur mon cas 🙂

Pour la deuxieme question c'était juste faire le copier coller de la colonne CJ à DD et non de BO à DD.
Comme les colonnes ne se suivent pas, c'est plus délicat. Il fautdrait donner un point de départ en CJ.

En tout cas merci de ton aide,

BlouBlou

gmb · 24 Mai 2013

Re : Copier coller en escalier

Bonjour
Cela convient-il ?

ROGER2327 · 24 Mai 2013

Re : Copier coller en escalier

Re...

bloublou à dit:
Bonjour ROGER2327,

Merci pour ton aide, cela marche bien sur mon cas 🙂

Pour la deuxieme question c'était juste faire le copier coller de la colonne CJ à DD et non de BO à DD.
Comme les colonnes ne se suivent pas, c'est plus délicat. Il fautdrait donner un point de départ en CJ.

En tout cas merci de ton aide,

BlouBlou

Pigé !

Quelques petites modifications suffisent. L'une des trois procédures suivantes devraient faire le boulot.

VB:

Sub tete()
Dim rngBas As Range, rngRes As Range
Dim oCom&, oColD&, oColG&, oBloc&
Dim i&, colDec&

    Set rngBas = ThisWorkbook.Worksheets("Base").Range("A1")
    Set rngRes = ThisWorkbook.Worksheets("Résultat").Range("A1")
    oCom = 66
    oColG = 22
    oColD = 42
    oBloc = 9

    colDec = oCom + oColG - 1

    rngBas.Resize(1, oCom).Copy Destination:=rngRes

    For i = 0 To oColD - oColG
        rngBas.Resize(oBloc, oCom).Offset(1).Copy Destination:=rngRes.Offset(1 + oBloc * i)
        rngBas.Resize(oBloc, 1).Offset(1, colDec + i).Copy Destination:=rngRes.Offset(1 + oBloc * i, oCom)
    Next

    rngRes.Parent.Cells.EntireColumn.AutoFit

End Sub

Sub tata()
Dim rngBas As Range, rngRes As Range
Dim oCom&, oColD&, oColG&, oBloc&
Dim i&

    Set rngBas = ThisWorkbook.Worksheets("Base").Range("A1")
    Set rngRes = ThisWorkbook.Worksheets("Résultat").Range("A1")
    oCom = 66
    oColG = 22
    oColD = 42
    oBloc = 9

    rngBas.Resize(1, oCom).Copy Destination:=rngRes

    For i = 0 To oColD - oColG
        rngBas.Resize(oBloc, oCom).Offset(1).Copy Destination:=rngRes.Offset(1 + oBloc * i)
        rngBas.Resize(oBloc, 1).Offset(1, oCom + oColG - 1 + i).Copy Destination:=rngRes.Offset(1 + oBloc * i, oCom)
    Next

    rngRes.Parent.Cells.EntireColumn.AutoFit

End Sub

Sub tutu()
Dim rngBas As Range, rngRes As Range
Dim oCom&, oColD&, oColG&, oBloc&
Dim i&

    Set rngBas = ThisWorkbook.Worksheets("Base").Range("A1")
    Set rngRes = ThisWorkbook.Worksheets("Résultat").Range("A1")
    oCom = 66
    oColG = 22
    oColD = 42
    oBloc = 9

    rngBas.Resize(1, oCom).Copy Destination:=rngRes

    For i = oColG - 1 To oColD - 1
        rngBas.Resize(oBloc, oCom).Offset(1).Copy Destination:=rngRes.Offset(1 + oBloc * (i - oColG + 1))
        rngBas.Resize(oBloc, 1).Offset(1, oCom + i).Copy Destination:=rngRes.Offset(1 + oBloc * (i - oColG + 1), oCom)
    Next

    rngRes.Parent.Cells.EntireColumn.AutoFit

End Sub

Les trois procédures font exactement la même chose. Seule diffère la façon de les écrire.

À noter que la procédure toto du précédent message peut aussi s'écrire comme suit :

VB:

Sub toto2()
Dim rngBas As Range, rngRes As Range
Dim oCom&, oColD&, oColG&, oBloc&
Dim i&, colDec&

    Set rngBas = ThisWorkbook.Worksheets("Base").Range("A1")
    Set rngRes = ThisWorkbook.Worksheets("Résultat").Range("A1")
    oCom = 66
    oColG = 1
    oColD = 42
    oBloc = 9

    colDec = oCom + oColG - 1

    rngBas.Resize(1, oCom).Copy Destination:=rngRes

    For i = 0 To oColD - oColG
        rngBas.Resize(oBloc, oCom).Offset(1).Copy Destination:=rngRes.Offset(1 + oBloc * i)
        rngBas.Resize(oBloc, 1).Offset(1, colDec + i).Copy Destination:=rngRes.Offset(1 + oBloc * i, oCom)
    Next

    rngRes.Parent.Cells.EntireColumn.AutoFit

End Sub

ROGER2327
#6651

Samedi 7 Merdre 140 (Nativité de Monsieur Plume, propriétaire - fête Suprême Quarte)
5 Prairial An CCXXI, 6,1189h - canard
2013-W21-5T14:41:07Z

Copier coller en escalier

bloublou

XLDnaute Occasionnel

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

bloublou

XLDnaute Occasionnel

gmb

XLDnaute Junior

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Copier coller en escalier

bloublou

XLDnaute Occasionnel

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

bloublou

XLDnaute Occasionnel

gmb

XLDnaute Junior

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency