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 |
Partager