Répéter une boucle n fois

Sub Test()
Dim I As Integer, J As Integer, PremL As Integer, DerL As Integer
With Sheets("Code")
For I = 1 To 3
PremL = .Range("A:A").Find("Cont " & I).Row
J = PremL
While .Cells(J, 1) <> ""
J = J + 1
Wend
DerL = J - 1
MsgBox "La zone s'étend de la ligne " & PremL & " à la ligne " & DerL
Next I
End With
End Sub

Sub Macro1()
dl = Range("A65000").End(xlUp).Row
x = 1
Do
    y = Range("A" & x).End(xlDown).Row
    Set plg = Range("A" & x & ":H" & y)
    plg.Sort Key1:=Range("C" & x), Order1:=xlAscending, Key2:=Range("F" & x) _
        , Order2:=xlAscending, Header:=xlYes
    x = y + 2
Loop Until x > dl

End Sub

Sub tri()
For n = 1 To Range("A65536").End(xlUp).Row
  If InStr(Range("A" & n), "Cont") <> 0 Then
    x = Range("A" & n).End(xlDown).Row
    Range("A" & n + 1 & ":H" & x).Sort Key1:=Range("C" & n + 1), Order1:= _
        xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
  End If
Next n
End Sub