bonjour Kantara,
Sub test()
Dim UN As Range, iR, iC
With Range("A1:K15")
For iC = 1 To .Columns.Count '=parcourir les colonnes
For iR = 1 To .Rows.Count - 1 '=parcourir les lignes
b = Not IsError(.Cells(iR, iC)) And Not IsError(.Cells(iR + 1, iC)) 'cellules ne contiennent pas des erreurs
If b Then b = StrComp(.Cells(iR, iC).Value, .Cells(iR + 1, iC).Value, 1) = 0 And .Cells(iR, iC) <> "" 'cellule & cellule dessous sont égales
If b Then 'les 2 conditions ici dessus okay
If UN Is Nothing Then Set UN = .Cells(iR, iC) 'si UN est vide commencer avec la premièe cellule
Set UN = Union(UN, .Cells(iR + 1, iC)) 'ajouter la cellule suivante
End If
If Not UN Is Nothing And (Not b Or iR = .Rows.Count - 1) Then 'fin des cellules égales ou fin de colonne et il y a des cellules égales
Application.DisplayAlerts = False 'pas de questions ambetants
UN.Merge 'fusionner
Application.DisplayAlerts = True
Set UN = Nothing 'RAZ UN
End If
Next
Next
End With
End Sub
Edit : salut Arturo83