Copier/Coller Loop

Sub copierSéquence()
    Const débutSeq As Long = 2012 ' mettre à jour selon le besoin
    Const nbCol As Long = 10 ' nombre de colonnes à nettoyer sur shDest
    '
    Dim shSource As Worksheet, shDest As Worksheet, plage As Range, celDest As Range
    Dim i As Long
    Set shSource = Worksheets("Feuil1")
    Set shDest = Worksheets("Feuil2")
    ' nettoyer
    shDest.[D4].Resize(shDest.[D65536].End(xlUp).Row - 3, nbCol).ClearContents
    'remplir
    Set plage = Range(shSource.[D5], shSource.[D:D].Find("Total général", LookIn:=xlValues, LookAt:=xlWhole).Offset(-1, 0))
    Set celDest = shDest.[D:D].Find("Séquence", LookIn:=xlValues, LookAt:=xlWhole).Offset(1, 0)
    If Not plage Is Nothing Then
        For i = 1 To 12
            celDest.Resize(plage.Rows.Count, 1) = plage.Value
            celDest.Resize(plage.Rows.Count, 1).Offset(0, 1) = débutSeq * 1000 + i
            Set celDest = celDest.End(xlDown).Offset(1, 0)
        Next i
    End If
End Sub