Merger cellules identiques par colonne et par ligne

[chrystobale]

Bonjour le forum,
Je souhaite un peu de support sur le problème suivant...
Je souhaite merger des cellules qui sont identiques d'une colonne à une autre et par ligne (donc dans un tableau).
je pense avoir "mal" positionner une variable car la macro marge des cellules mais uniquement jusqu'à "4" ... alors que d'après l'exemple de la 1er ligne de mon tableau, les 6 cellules sur la ligne 1 devraient être Margées ...

Auriez vous une idée .... voici l'extrait de mon code:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Sub MergeSameProject()
 
Application.ScreenUpdating = True
Dim i As Long, j As Long, EndOfColumnLine1 As Long, EndOfLineColumnA As Long, ligne As Long
Application.DisplayAlerts = False
EndOfColumnLine1 = Cells(1, Columns.Count).End(xlToLeft).Column
'EndOfColumnLine1 = Cells(1, Columns.Count).End(xlToLeft).Column
EndOfLineColumnA = Range("A65536").End(xlUp).Row
MsgBox "EndOfColumnLine1 = " & EndOfColumnLine1
MsgBox "EndOfLineColumnA = " & EndOfLineColumnA
For ligne = 2 To EndOfLineColumnA
'ligne = 2
        For Column = 2 To EndOfColumnLine1 ' Cells(ligne, Columns.Count).End(xlToLeft).Column
                For j = 1 To (EndOfColumnLine1 - 1)
                    If Cells(ligne, Column) <> "" Then
                        If Cells(ligne, Column + j) = Cells(ligne, Column) Then _
                        Range(Cells(ligne, Column), Cells(ligne, Column + j)).MergeCells = True 'true
                    Column = Column + j - 1
                    MsgBox Column
                    End If
 
                    End If
 
                Next
        Next Column
Next
Application.DisplayAlerts = True
End Sub

cdt,
Chris