Copier une ligne à côté d'une autre

MAJ : J'ai réussi quelque chose mais il me faut l'automatiser, une idée ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Sub Copieligne()
    Dim ligne As String
    Dim column As Integer
 
    ligne = ActiveCell.Row
    colonne = ActiveCell.column
 
    Range("A1: F1").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Range("A2: F2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("M2").Select
    ActiveSheet.Paste
    Range("A3: F3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("S3").Select
    ActiveSheet.Paste
 
End Sub

Merci pour votre retour