VBA peut-on réduire le nombre de boucle

Set c = Worksheets("5-9-12").Range("D" & Worksheets("5-9-12").Range("D65536").End(xlUp).Row)
Do While c.Row > 1
'Remise à 0 des compteurs somme à chaque boucle
Somme& = 0
Somme1& = 0
Somme2& = 0
  With Worksheets("5-17").Range("F2:F" & Worksheets("5-17").Range("F65536").End(xlUp).Row)
    Set d = .Find(c)
        If Not d Is Nothing Then
            Départ = d.Address
            Do
                c(2, 1).EntireRow.Insert
                c(2, 0) = "N° ASN"
                
                'n° d'ASN
                c(2, 1) = d(1, 26)
                If c(2, 0) = "N° ASN" Then
                   c(2, 3) = 0
                   c(2, 4) = 0
                   c(2, 5) = 0
                   c(2, 6) = 0
                   c(2, 7) = 0
                   Else
                End If
                'qt dans l'ASN
                c(2, 8) = d(1, 6)
                'Qté en transit
                c(2, 12) = d(1, 7)
                'Qté réceptionnée C3D
                If c(1, 3) > c(1, 4) And c(2, 10) = "" And c(2, 12) = "" Then
                    c(1, 6) = c(1, 3) - c(1, 4)
                    Else
                    If c(2, 12) <> 0 Then
                        c(2, 10) = 0
                        Else
                    c(2, 10) = c(2, 8)
                    End If
                End If
                'Répète le fournisseur
                c(2, -1) = c(1, -1)
                'Répète le modèle
                c(2, -2) = c(1, -2)
                'date rct-po
                c(2, 9) = d(1, 5)
                'date rct-c3d
                c(2, 11) = d(1, 19)
                'date prévue c3d
                c(2, 13) = d(1, 36)
                'Somme des RCT-PO
                Somme& = d(1, 6) + Somme&
                'Somme des réceptions C3D
                Somme1& = c(2, 10) + Somme1&
                'Somme des quantités en transit
                Somme2& = c(2, 12) + Somme2&
                
                Set d = .FindNext(d)
            Loop While Not d Is Nothing And d.Address <> Départ
        End If
  End With
   
'Fait le total de tout (qt dans l'ASN = RCT-PO, Qté réceptionnée C3D, Qté en transit)
c(1, 5) = Somme&
c(1, 6) = Somme1&
c(1, 7) = Somme2&
Set c = c(0, 1)

Loop