Sub Fusionner()
Dim ncol%, i&, h&, j%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Feuil1.UsedRange 'CodeName de la feuille
ncol = .Columns.Count
Union(.Columns(1), .Columns(3).Resize(, ncol - 2)).UnMerge 'défusionne toutes les colonnes sauf la colonne B
For i = 1 To .Rows.Count
If .Cells(i, 2) <> "" Then
h = .Cells(i, 2).MergeArea.Rows.Count
If h > 1 Then
For j = 1 To ncol
If j <> 2 Then
.Cells(i, j) = Ajouter(.Cells(i, j).Resize(h), j < 7 Or j > 13, j < 9 Or j > 13)
.Cells(i, j).Resize(h).Merge 'fusionne
End If
Next j
End If
End If
Next i
End With
End Sub
Function Ajouter(tablo, premier As Boolean, concat As Boolean)
Dim i&
If premier Then Ajouter = tablo(1, 1): Exit Function
tablo = tablo 'matrice, plus rapide
For i = 2 To UBound(tablo)
If concat Then
If tablo(i, 1) <> "" Then tablo(1, 1) = tablo(1, 1) & ";" & tablo(i, 1)
ElseIf IsNumeric(tablo(1, 1)) Then
If IsNumeric(tablo(i, 1)) Then tablo(1, 1) = CDbl(tablo(1, 1)) + CDbl(tablo(i, 1))
End If
Next
Ajouter = tablo(1, 1)
End Function