Excel et les chaînes de caractères

Private Sub CommandButton1_Click()
Dim i As Long, pc1 As Double, pc2 As Double
With Sheets("Regrouper")
  Cells.Copy .Cells
  '---suppression des chiffres en fin de texte et autres fioritures---
  For i = 3 To .Range("A5536").End(xlUp).Row
1   If IsNumeric(Right(RTrim(.Cells(i, 1)), 1)) Then .Cells(i, 1) = Left(.Cells(i, 1), Len(.Cells(i, 1)) - 1): GoTo 1
    .Cells(i, 1) = Application.Trim(Replace(.Cells(i, 1), "-", " ")) 'suppression des tirets et espaces superflus
  Next
  .Range("A2:E65536").Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes 'tri
  '---suppression des doublons avec addition des volumes et pourcentages---
  On Error Resume Next
  For i = .Range("A5536").End(xlUp).Row To 4 Step -1
    If .Cells(i, 1) = .Cells(i, 1).Offset(-1) Then
      pc1 = 0: pc2 = 0
      pc1 = (.Cells(i, 2) + .Cells(i, 2).Offset(-1)) / (.Cells(i, 2) / .Cells(i, 3) + .Cells(i, 2).Offset(-1) / .Cells(i, 3).Offset(-1))
      pc2 = (.Cells(i, 4) + .Cells(i, 4).Offset(-1)) / (.Cells(i, 4) / .Cells(i, 5) + .Cells(i, 4).Offset(-1) / .Cells(i, 5).Offset(-1))
      .Cells(i, 2).Offset(-1) = .Cells(i, 2) + .Cells(i, 2).Offset(-1)
      .Cells(i, 4).Offset(-1) = .Cells(i, 4) + .Cells(i, 4).Offset(-1)
      .Cells(i, 3).Offset(-1) = IIf(pc1, pc1, "")
      .Cells(i, 5).Offset(-1) = IIf(pc2, pc2, "")
      .Rows(i).Delete
    End If
  Next
  .Activate
End With
End Sub

Private Sub CommandButton1_Click()
Dim i As Long, n As Byte, j As Byte, v As Double, pc As Double
With Sheets("Regrouper")
  Cells.Copy .Cells
  '---suppression des chiffres en fin de texte et autres fioritures---
  For i = 3 To .Range("A5536").End(xlUp).Row
1   If IsNumeric(Right(RTrim(.Cells(i, 1)), 1)) Then .Cells(i, 1) = Left(.Cells(i, 1), Len(.Cells(i, 1)) - 1): GoTo 1
    .Cells(i, 1) = UCase(Application.Trim(Replace(.Cells(i, 1), "-", " "))) 'suppression des tirets et espaces superflus, mise en majuscules
  Next
  .Range("A3:[COLOR="Red"]IV[/COLOR]65536").Sort Key1:=.Range("A3"), Order1:=xlAscending, Header:=xlNo 'tri
  '---suppression des doublons avec addition des volumes et pourcentages---
  On Error Resume Next
  [COLOR="Red"]n = Application.CountA(.Rows(1)) 'nombre de mois à traiter[/COLOR]
  For i = .Range("A5536").End(xlUp).Row To 4 Step -1
    If .Cells(i, 1) = .Cells(i, 1).Offset(-1) Then
      [COLOR="Red"]For j = 2 To 2 * n Step 2
        v = .Cells(i, j) + .Cells(i - 1, j)
        pc = 0 'en cas d'erreur ligne suivante
        pc = v / (.Cells(i, j) / .Cells(i, j + 1) + .Cells(i - 1, j) / .Cells(i - 1, j + 1))
        .Cells(i - 1, j) = v
        .Cells(i - 1, j + 1) = IIf(pc, pc, "")
      Next[/COLOR]
      .Rows(i).Delete
    End If
  Next
  .Activate
End With
End Sub