Sub rassemble()
Dim tablo() As Variant 'déclaration d'un tableau VBA
With Sheets("DI") ' avec les feuille DI
.UsedRange.Offset(1, 0).Clear 'on efface tout SAUF la première ligne
End With
For Each ws In Worksheets 'pour chaque feuille du classeur
If ws.Name <> "DI" And ws.Name <> "ACCUEIL" Then 'si le nom de la feuille testée est différent de DI
With ws 'avec la feuille testée
fin = .Range("B" & .Rows.Count).End(xlUp).Row 'on récupère le numéro de la dernière ligne en colonne B
tablo = .Range("G5:I" & fin).Value 'on met de G5 à I fin dans le tablo
End With
For i = LBound(tablo, 1) To UBound(tablo, 1)
tablo(i, 2) = ws.Name 'on met le nom de la feuille dans la seconde colonne du tableau
Next i
With Sheets("DI") 'on colle le tablo dans la feuille DI
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
End With
End If
Next ws
End Sub