Création de boucle

Sub comparaison()
Range("D2").Select
Var = Worksheets("DU par Unité").Range("D2").Value
Var1 = ActiveCell.Offset(1, 0).Value
If Var = Var1 Then Range("D2", ActiveCell.Offset(1, 0)).merge Else: MsgBox "Pas Egal"
End Sub

Sub comparaisonb()
Dim i As Long, y As Long
Dim coL As Integer 'N° de colonne
Dim derL As Long  'derniére ligne
Dim vaR As Variant

coL = 4
Worksheets("DU par Unité").Activate
derL = Rows.Count
derL = Cells(derL, coL).End(xlUp).Row 'derniére ligne utilisée

For i = 1 To derL
vaR = Cells(i, coL).Value
  If vaR = Empty = False Then
      If vaR = Cells(i, coL).Offset(1, 0).Value Then
      
          For y = i To derL
          Cells(y, coL).Select ' test W
            If vaR <> Cells(y, coL).Value Then Exit For
          Next y
      
        'Range(Cells(i + 1, coL), Cells(i + 1, coL).Offset(y - i - 2, 0)).Select
        Range(Cells(i + 1, coL), Cells(i + 1, coL).Offset(y - i - 2, 0)) = Empty
        
        With Range(Cells(i, coL), Cells(i + 1, coL).Offset(y - i - 2, 0))
         .Merge
         .VerticalAlignment = xlCenter
        End With
      i = y - 1
      End If
  End If
Next i

End Sub