Copier coller en escalier

[bloublou]

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]

Re : Copier coller en escalier

Bonsoir bloublou

Un essai pour le premier problème.​

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 :

(...)
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]

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]

Re : Copier coller en escalier

Bonjour
Cela convient-il ?

 

[ROGER2327]

Re : Copier coller en escalier

Re...

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.​

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 :​

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