XL 2021 Copie de certaines données Excel sur Word

Sub Factures()
Dim t#, plage As Range, saison$, chemin1$, chemin2$, nomDoc$, Wapp As Object, i&, n&, Doc As Object, nom$, total#
t = Timer
Set plage = Sheets("Compta").[A1].CurrentRegion
saison = plage(1)
chemin1 = ThisWorkbook.Path & "\"
chemin2 = chemin1 & "FACTURES " & saison & "\"
If Dir(chemin2, vbDirectory) = "" Then MkDir chemin2 'crée le sous-dossier
nomDoc = "Modèle de facture adhérents.doc" 'nom adaptable
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
On Error GoTo 0
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
With Sheets("Licences").[A1].CurrentRegion
    For i = 2 To .Rows.Count
        If Trim(.Cells(i, 3)) <> "" Then
            n = n + 1
            Set Doc = Wapp.Documents.Open(chemin1 & nomDoc) 'ouvre le document Word
            nom = .Cells(i, 3) & " " & .Cells(i, 4)
            Doc.Bookmarks("SG1").Range = IIf(.Cells(i, 5) = "M", "Monsieur ", IIf(.Cells(i, 5) = "F", "Madame ", "")) & nom
            Doc.Bookmarks("SG2").Range = .Cells(i, 2)
            total = Application.SumIfs(plage.Columns(28), plage.Columns(1), .Cells(i, 3), plage.Columns(2), .Cells(i, 4)) 'SOMME.SI.ENS
            Doc.Bookmarks("SG3").Range = Format(total, "#,##0.00 €")
            Doc.Bookmarks("SG4").Range = NbToLettresFSB(CStr(total), "euro")
            Doc.SaveAs chemin2 & nom & " " & saison & ".doc" 'enregistrement
            Doc.Close 'ferme le document word
        End If
    Next i
End With
If Wapp.Documents.Count = 0 Then Wapp.Quit 'ferme Word
MsgBox n & IIf(n < 2, " facture éditée", " factures éditées") & " en " & Format(Timer - t, "0.00 \sec"), , saison
End Sub