Rassembler données de doublons multi critéres (Expert VBA requis)

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
                                'POINT A AMELIORER
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If True Then

'Suppression des doublons
    CurrentRow = iStartRow
    bSautPageDone = False
    Go = True
    Do While (CurrentRow < iLastRow And Go)
            
        s24hInit = Cells(CurrentRow, sPosteCol).Value
        sMouleInit = Cells(CurrentRow, SMouleCol).Value
        sProgInit = Cells(CurrentRow, sProgrammePostCol).Value
        
        sCodeTissu = Cells(CurrentRow, sTissuCol - 2).Value
        sLargeur = Cells(CurrentRow, sLargeurCol).Value
        
        sMachine = Cells(CurrentRow, sMachine1Col).Value
        
'Saut de page pour les Qt a 0
        If (Cells(CurrentRow, sProgrammePostCol) = 0 And Not bSautPageDone) Then
            iSautPageNum = CurrentRow
            bSautPageDone = True
            'SautPage
        End If
        
'Mise en forme du premier champ de commentaire si ligne non vide
        If (sCodeTissu <> "" Or sLargeur <> "" Or sMachine <> "") Then
            Cells(CurrentRow, sCommConfCol).Value = "'" & Cells(CurrentRow, sRolCol + 1).Value & " " & Cells(CurrentRow, sCommConfCol).Value & " "
        Else
            Go = False
        End If
        
    Workrow = CurrentRow + 1

    sCodeTissu1 = Cells(Workrow, sTissuCol - 2).Value
    sLargeur1 = Cells(Workrow, sLargeurCol).Value
    sMachine1 = Cells(Workrow, sMachine1Col).Value
        
    Dim sIsMultiPlis As Boolean
    sIsMultiPlis = Cells(Workrow, 1).Value <> ""
                      
    While (sCodeTissu = sCodeTissu1 And sLargeur = sLargeur1 And sMachine = sMachine1 And (sCodeTissu <> "" Or sLargeur <> "" Or sMachine <> "") And Not sIsMultiPlis)
    'rolhing + commentaire
    Cells(CurrentRow, sCommConfCol).Value = Cells(CurrentRow, sCommConfCol).Value & Cells(Workrow, sCommConfCol).Value & " "

    'Copy des quantités
    Range(Cells(Workrow, 23), Cells(Workrow, 34)).Copy
    Range(Cells(Workrow, 23), Cells(Workrow, 34)).Offset(-1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
        :=False, Transpose:=False
                
    Range(Cells(Workrow, 16), Cells(Workrow, 19)).Copy
    Range(Cells(Workrow, 16), Cells(Workrow, 19)).Offset(-1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
        :=False, Transpose:=False
                      
'Suppression de la ligne
    Cells(Workrow, 1).EntireRow.Delete Shift:=xlUp
                        
'Mise a jour des valeur pour l'iteration suivante
    sCodeTissu1 = Cells(Workrow, sTissuCol - 2).Value
    sLargeur1 = Cells(Workrow, sLargeurCol).Value
    sMachine1 = Cells(Workrow, sMachine1Col).Value
    
    Wend
        
'Division en nombre de K7
     Cells(CurrentRow, 19).Select
        If Cells(CurrentRow, 7).Value = "KM" Then
            ActiveCell.Value = ActiveCell.Value / smetrageK7KM
        Else
            ActiveCell.Value = ActiveCell.Value / smetrageK7EST
        End If
        
        CurrentRow = CurrentRow + 1
    Loop
    
End If


'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX