Pb avec mon Loop, Help me pls :)

Bonjour à tous,

J'ai une boucle qui me permet de dupliquer le titre d'une colonne d'un TCD excel et quand le titre change, le dupliquer change aussi.
Mais une fois que j'arrive à la fin (cellule vide dans D4), la boucle s'arrête ce qui est normal mais la macro ne continue pas la suite.

Pouvez-vous m'aider SVP, je ne comprends plus

'Copier les noms d'agence'
Dim Ligne As Integer
Dim Référence As String

Range("D4" ).Activate
ActiveCell.End(xlDown).Activate
Ligne = ActiveCell.Row

Range("A5" ).Activate
Référence = ActiveCell.Value
ActiveCell.Offset(1, 0).Activate

Do While ActiveCell.Row <> Ligne
Do While ActiveCell.Value = 0
ActiveCell.Value = Référence
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Row > Ligne Then
Exit Sub
End If
Loop
Référence = ActiveCell.Value
ActiveCell.Offset(1, 0).Activate

Loop

'Mise en place de filtres'
Range("A4" ).Select
Selection.AutoFilter
Columns("A:N" ).EntireColumn.AutoFit




Merci d'avance