Créer un sous total après importation de variables

Bonjour à tous ,

Cela fait quelques semaines que je galère sur mon code, sans trouver de réponse.

Voilà le problème qui se pose à moi :

J'aimerai après chaque import, que s'affiche mon sous total de dalles, en l'occurence.

Cependant avec mon code, cela fonctionne pour les deux premier niveaux mais pas pour ceux qui suivent, ils prennent en compte les valeurs qui précèdent, à mon grand désarroi.

Je vous joints la partie de mon code qui bloque :

' Ajout de la ligne sous-total quand on a plus d'un élément identique

                If A = 1 Then
                    ThisWorkbook.Sheets("Estimatif BAC").Activate
                    ThisWorkbook.Sheets("basequantitatif").Activate
                    Range("base_soustotal").Select
                    Selection.Copy
                    ThisWorkbook.Sheets("Estimatif BAC").Activate
                    ActiveSheet.Paste
                    ActiveCell.Offset(0, 0).Select

                    R = Application.WorksheetFunction.CountIf(Range("B:B"), "*Radier *")
                    P = Application.WorksheetFunction.CountIf(Range("B:B"), "*Plancher *")
                    D = Application.WorksheetFunction.CountIf(Range("B:B"), "*Dallage *")
                    X = R + P + D
                        For j = 8 To 12
                        ActiveCell.Offset(0, j).FormulaR1C1 = "=Sum(R" & ActiveCell.Row - X & "C:R" & ActiveCell.Row - 1 & "C)"
                        Next j
                End If

            If A > 1 Then
                Do
                    ThisWorkbook.Sheets("Estimatif BAC").Activate
                    ThisWorkbook.Sheets("basequantitatif").Activate
                    Range("base_soustotal").Select
                    Selection.Copy
                    ThisWorkbook.Sheets("Estimatif BAC").Activate
                    ActiveSheet.Paste
                    ActiveCell.Offset(0, 0).Select

                    NLg = A + 1

                    P = Application.WorksheetFunction.CountIf(Range("Nlg:B"), "*Plancher*")

                    X = P
                        For j = 8 To 12
                        ActiveCell.Offset(0, j).FormulaR1C1 = "=Sum(R" & ActiveCell.Row - X & "C:R" & ActiveCell.Row - 1 & "C)"
                        Next j
               Loop While A = 15
            End If

N'hésitez pas à me demander si mon fichier est nécessaire

Merci d'avance à ceux qui se pencheront sur mon problème !