XL 2013 Incrémenter une feuille issue d'autres feuilles

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

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("F" & .Rows.Count).End(xlUp).Row 'on récupère le numéro de la dernière ligne en colonne F
             tablo = .Range("F6:H" & fin).Value 'on met de G5 à H 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