Sub TransfertDonnees()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rg As Range
Dim L1 As Integer, L2 As Integer
Dim rgC As Range, rgP As Range
Application.ScreenUpdating = False
Set ws1 = ThisWorkbook.Sheets("Var_FTE_R22011.12") 'feuille de départ
Set ws2 = ThisWorkbook.Sheets("Feuil1") 'feuille de destination
'Lignes de départ et fin
L1 = 12
L2 = 133
Set rg = ws1.Range("I8") 'cellule de départ
Do Until IsEmpty(rg)
'Copie des lignes 12 à 133 dans la colonne V
Set rgP = ws2.Range("V65536").End(xlUp).Offset(1, 0) 'cellule de destination
Set rgC = Range(ws1.Cells(L1, rg.Column), ws1.Cells(L2, rg.Column))
rgC.Copy rgP
'Copie de la colonne C dans W
Set rgC = ws1.Range("C" & L1).Resize(L2 - L1 + 1, 1)
Set rgP = ws2.Range("W" & rgP.Row).Resize(L2 - L1 + 1, 1)
rgC.Copy rgP
'Copie de la colonne D dans Y
Set rgC = ws1.Range("D" & L1).Resize(L2 - L1 + 1, 1)
Set rgP = ws2.Range("Y" & rgP.Row).Resize(L2 - L1 + 1, 1)
rgC.Copy rgP
'Colonne C
ws2.Range("C" & rgP.Row).Resize(L2 - L1 + 1, 1) = rg 'colonne C
Set rg = rg.Offset(0, 1) 'on décale de 1 colonne
Loop
Application.ScreenUpdating = True
End Sub