Si plusieur cellules contient "texte" Alors fusionner

Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim T As Long 'déclare la variable T (Total)

Set O = Sheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 2 (=B) de l'onglet O
For I = DL - 1 To 4 Step -1 'boucle inversée de l'avant dernière ligne à la ligne 4 (en remontant)
    If O.Cells(I, 2).Value = "KHI2 50%" And O.Cells(I + 1, 2).Value = "KHI2" Then 'condition : si la cellule de I vaut "KIH2 50%" et la cellule de I+1 vau "KIH2"
        T = CLng(O.Cells(I, 3).Value) + CLng(O.Cells(I + 1, 3).Value) 'calcule le total
        O.Cells(I, 2).Value = "KIH2" 'place "KIH2" dans la cellule de I
        O.Cells(I, 3).Value = T 'place le total dans la cellule adjacente
        O.Rows(I + 1).Delete 'supprime la ligne I+1
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
End Sub

Sub regroup()
For n = 2 To Sheets("Total par action (Auto)").Range("A" & Rows.Count).End(xlUp).Row
 If Sheets("Total par action (Auto)").Range("A" & n) = "KHI2 50%" Or Sheets("Total par action (Auto)").Range("A" & n) = "KHI2" Then
    KHI2 = KHI2 + Sheets("Total par action (Auto)").Range("B" & n)
    Sheets("Total par action (Auto)").Range("A" & n & ":B" & n).Delete
    n = n - 1
 End If
Next
If KHI2 <> "" Then
 Rows(3).Insert
 Sheets("Total par action (Auto)").Range("A3") = "KHI2"
 Sheets("Total par action (Auto)").Range("B3") = KHI2
End If
End Sub

Sub group(a)
For n = 2 To Sheets("Total par action (Auto)").Range("A" & Rows.Count).End(xlUp).Row
 If Sheets("Total par action (Auto)").Range("A" & n) = a Or Sheets("Total par action (Auto)").Range("A" & n) = a & " 50%" Then
    tot = tot + Sheets("Total par action (Auto)").Range("B" & n)
    Sheets("Total par action (Auto)").Range("A" & n & ":B" & n).Delete
    n = n - 1
 End If
Next
If tot <> "" Then
 Rows(3).Insert
 Sheets("Total par action (Auto)").Range("A3") = a
 Sheets("Total par action (Auto)").Range("B3") = tot
End If
End Sub
Sub regroup()
For n = 2 To Sheets("Total par action (Auto)").Range("A" & Rows.Count).End(xlUp).Row
 If InStr(Sheets("Total par action (Auto)").Range("A" & n), " 50%") <> 0 Then
 a = Replace(Sheets("Total par action (Auto)").Range("A" & n), " 50%", "")
 Call group(a)
 End If
Next
End Sub

Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim R1 As Range 'déclare la variable R1 (Recherche 1)
Dim R2 As Range 'déclare la variable R2 (Recherche 2)
Dim T As Long 'déclare la variable T (Total)

Set O = Sheets("Total par action (Auto)") 'définit l'onget O
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière Ligne éditée DL de la colonne 1 (=A) de l'onglet O
Set PL = O.Range("A3:A" & DL) 'définit la plage PL
Set D = CreateObject("Scripting.Dictionary") 'définit la dictionnaire D
For Each CEL In PL 'boucle sur toutes les celluiles CEL de la plage PL
    'si le dernier caractère de la valeur de la cellule est "%", alimente le dictionnaire D
    If Right(CEL.Value, 1) = "%" Then D(CEL.Value) = ""
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des valeurs terminant par % (sans doublon)
For I = 0 To UBound(TMP) 'boucle sur toutes les valeurs du tableau temporaire TMP
    Set R1 = PL.Find(TMP(I), , xlValues, xlWhole) 'définit la recherche R1 (recherche TMP(I) dans la plage PL)
    'définit la recherche R2 (recherche TMP(I) sans les 4 dernièrs caractères " 50%"  dans la plage PL)
    Set R2 = PL.Find(Left(TMP(I), Len(TMP(I)) - 4), , xlValues, xlWhole)
    If Not R2 Is Nothing Then 'si il exite au moins une occurrence trouvée pour la recherche R2
        T = CLng(R1.Offset(0, 1).Value) + CLng(R2.Offset(0, 1).Value) 'définit le total T
        R2.EntireRow.Delete 'supprime la ligne de l'occurrence trouvée pour la recherche R2
        R1.Value = Left(TMP(I), Len(TMP(I)) - 4) 'redéfinit la valeur de la recherche 1 (sans les 4 derniers caractères " 50%")
        R1.Offset(0, 1).Value = T 'place le total dans la cellule adjacente à R1
    End If 'fin de la condition
Next I 'prochaine valeur de la boucle
End Sub