J'ai pas tout compris au code mais on y est presque, il m'a retourné ce résultat, je pense que c'est un problème avec la boucle. Il a cumulé les 2 (BEG804 et BEG805) pour remplir la 3ème occurrence (BG501G) :
au final il m'a renseigné 655361 lignes.
J'ai ce code :
For i = 0 To nbChantier
'Copie du code chantier
Worksheets("Chantiers").Select
Chantier = Range("A" & i + 1)
'Copie des lignes de la société et Chantiers
'Pour les 1ères lignes
If i = 0 Then
Worksheets("Liste").Select
For j = 1 To nbLignes
Range("A" & j + 1) = Societe
Range("B" & j + 1) = Chantier
Next j
End If
'Pour les lignes suivantes
If i >= 1 Then
Worksheets("Liste").Select
'Copie du bloc
Set Plage = Range("A2:H" & [A:H].Find("*", , , , xlByRows, xlPrevious).Row)
Plage.Copy Cells(Plage.Row + Plage.Rows.Count, 1)
Res = Plage.Resize(, 1).Offset(, 1)(Plage.Rows.Count)
Res = Application.Index([Chantiers!A:A], Application.Match(Res, [Chantiers!A:A], 0) + 1)
Plage.Copy Cells(Plage.Row + Plage.Rows.Count, 1)
Cells(Plage.Row + Plage.Rows.Count, 2).Resize(Plage.Rows.Count) = Res
End If
Next i
End Sub