Macro copier coller par colonne

Bonjour a tous

J'ai un petit souci avec ma macro elle ne fonctionne pas correctement.

J'essaie de copier Feuil1 A1:C4 pour coller en Feuil2 A1:C4, mais que si je relance la macro une seconde fois il recopie colle en Feuil2 a droite de ce qui existe déjà, c'est a dire par colonne et non par ligne (les une en dessous des autres).

Voir petit fichier joint (la seconde parti du code c'est pas bon en F02)

Merci de votre aide

Bonjour Muratime, bonjour le forum,

Essaie comme ça :

Sub copier()
Dim DL As Integer

F01.Range("A1:C4").Copy
With F02
    DL = IIf(.Range("A1").Value = "", 1, .Cells(Application.Rows.Count, "A").End(xlUp).Row + 1)
    .Cells(DL, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With
End Sub

Bonjour ThauThème, le code fonctionne sauf qu'il me colle de haut en bas et non pas de gauche a droite

Bonjour

au plus simple a voir

Sub copier()
    F01.Range("A1:C4").Copy

    F02.Range("A1").PasteSpecial xlPasteValues
End Sub

A+

Maurice

Bonjour le fil, bonjour le forum,

Désolé Muratime mais je ne comprends pas. Je propose que tu mettes en pièce jointe un fichier avec ce que tu voudrais après avoir lancé deux fois la macro. Ça nous permettra de mieux comprendre...

archer a écrit :

Bonjour

au plus simple a voir

Sub copier()
    F01.Range("A1:C4").Copy

    F02.Range("A1").PasteSpecial xlPasteValues
End Sub

A+

Maurice

Merci archer mais ce code va juste copier coller, de Feuil1 A1:C4 en feuil2 A1:C4 mais ce que je voudrais si le lance plusieurs fois la macro c'est qu'ensuite il recolle en Feuil2 D1:F4 ensuite de G1:I4 et ainsi de suite sans supprimer ce qu'il avait déjà copier avant. Et non pas de haut en bas.

ThauThème a écrit :

Bonjour le fil, bonjour le forum,

Désolé Muratime mais je ne comprends pas. Je propose que tu mettes en pièce jointe un fichier avec ce que tu voudrais après avoir lancé deux fois la macro. Ça nous permettra de mieux comprendre...

C'est ce que j'ai mis en Feuil2 en jaune le résultat souhaité et deux entouré de noire pour dire que le collage se fait de gauche a droite.

En gros si je fais ça avec l'enregistreur de macro ça donnerais ça sauf si je veux copier coller 50 fois je ne vais pas faire 50 macros car les données en Feuil1 ne seront pas les mêmes of course.

Sub Macro1()

    Sheets("Feuil1").Select
    Range("A1:C4").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub
Sub Macro2()

    Sheets("Feuil1").Select
    Range("A1:C4").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Range("D1").Select
    ActiveSheet.Paste
End Sub
Sub Macro3()

    Sheets("Feuil1").Select
    Range("A1:C4").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Range("G1").Select
    ActiveSheet.Paste
End Sub

Re,

J'avais mal compris au début. Je croyais que ce que tu montrais été ce que tu avais mais que tu voulais que ça copie en-dessous.

Le code modifié :

Sub copier()
Dim DC As Integer

F01.Range("A1:C4").Copy
With F02
    DC = IIf(.Range("A1").Value = "", 1, .Cells(1, Application.Columns.Count).End(xlToLeft).Column + 1)
    .Cells(1, DC).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With
End Sub

Voilà c'est exactement ça que je voulais de gauche a droite un grand merci a toi ThauThème

Bonsoir

si tu veux copier 4 fois de suite

Sub copier()
Dim DC As Long
F01.Range("A1:C4").Copy
    For DC = 1 To 10 Step 3
        F02.Cells(1, DC).PasteSpecial xlPasteValues
    Next
Application.CutCopyMode = False
End Sub

bon je ferme A+

Maurice

archer a écrit :

Bonsoir

si tu veux copier 4 fois de suite

Sub copier()
Dim DC As Long
F01.Range("A1:C4").Copy
    For DC = 1 To 10 Step 3
        F02.Cells(1, DC).PasteSpecial xlPasteValues
    Next
Application.CutCopyMode = False
End Sub

bon je ferme A+

Maurice

Merci archer, ta formule elle va me servir mais pour autre chose donc j'ai adapté comme ça. Mais supposons que je veuille copier 30 fois de suite, mais ensuite faire la ligne suivante de Feuil1 et 30 fois et ainsi de suite autant qu'il y a de ligne sur Feuil1. La le code il copie colle mais cette fois de haut en bas.

Sub copier()
Dim i As Long
Application.ScreenUpdating = False
F01.Range("C2:D2").Copy 'ICI JE COPIE JUSTE DEUX CELLULES SUR UNE LIGNE. Peu être il faudrait un truc du genre ("C2:D et nbr de ligne")
    For i = 2 To 31 Step 1
        F02.Cells(i, 1).PasteSpecial xlPasteValues
    Next
Application.CutCopyMode = False
End Sub

Je met un fichier pour mieux comprendre. En feuil2 c'est le résultat souhaité par rapport à la Feuil1.