Ecrire donnée dans un autre fichier

Bonjour à toutes et tous,

Je m'interroge sur la façon de procéder fin d'insérer des données dans un fichier excel via macro

En effet, je récupère tout d'abord des données dans une base de donnée

With Worksheets("Positionning").ListObjects(1)

    Tbl = .ListColumns("Id_Project").Range

        Set d = .ListColumns("Id_Project").Range.Find(what:=id_projet, LookIn:=xlValues, LookAt:=xlWhole)
        If Not d Is Nothing Then
            nbr = Application.Count(Application.Match(Tbl, Array(id_projet), 0))
            Set Partners_Array = d.Resize(nbr, 5)
End If
End With

puis pourrais les inscrire via

Count_Partners = Partners_Array.Rows.Count

  If (Count_Partners >= 1) Then
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A87") = "Partner " & Partners_Array.Cells(1, 2)
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B87") = Partners_Array.Cells(1, 3)
End If

cela fonctionne seulement cela m'obligerait a créer autant de lignes de codes que de résultats possible. comme je dois avoir possiblement jusqu’à 60 résultats cela ne me parait pas un bon codage :)

Aussi comment procéder afin que les résultats de l'array s'affiche correctement?

de sorte à avoir

premier résultat en ligne 87 colonne A et B

If (Count_Partners >= 1) Then
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A87") = "Partner " & Partners_Array.Cells(1, 2)
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B87") = Partners_Array.Cells(1, 3)
End If

deuxieme en ligne 88 colonne A et B

  If (Count_Partners >= 2) Then
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A88") = "Partner " & Partners_Array.Cells(2, 2)
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B88") = Partners_Array.Cells(2, 3)
End If

etc..

?

merci par avance pour vos pistes

bonne fin de journée