Option Explicit
Option Compare Text

Sub Gesamt()
  Dim i As Long, j As Long
  Dim sArrBlatt() As String, sArrList() As String
  Dim iNotfound As Long, iZeile() As Long, iAnz As Long

' Speed ein
  With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
  End With

' Einlesen der Tabellenblattnamen und Listobjektnamen in Array
  For j = 1 To ThisWorkbook.Worksheets.Count
     With ThisWorkbook.Worksheets(j)
        If Not .Name Like "GSV" And .ListObjects.Count > 0 Then
           ReDim Preserve sArrBlatt(i)
           ReDim Preserve sArrList(i)
           sArrBlatt(i) = .Name
           sArrList(i) = .ListObjects(1)
           i = i + 1
        End If
     End With
  Next j
  ReDim iZeile(UBound(sArrBlatt))

' Löschen der Datenbereiche aller Tabellen
  For j = 0 To UBound(iZeile)
     With ThisWorkbook.Worksheets(sArrBlatt(j)).ListObjects(sArrList(j))
        If .ListRows.Count >= 1 Then .DataBodyRange.Delete
     End With
  Next j
  
' Übertragen der Daten
  With ThisWorkbook.Worksheets("GSV").ListObjects("Tabelle1").DataBodyRange
     For i = 1 To .Rows.Count
        For j = 0 To UBound(iZeile)
           If sArrBlatt(j) Like "*" & .Cells(i, 2).Value & "*" Or _
           .Cells(i, 2).Value Like "*" & sArrBlatt(j) & "*" Then
           iZeile(j) = iZeile(j) + 1: iAnz = iAnz + 1
           ThisWorkbook.Worksheets(sArrBlatt(j)).Range(sArrList(j)).Rows(iZeile(j)).Value = .Rows(i).Value
           Exit For
        End If
     Next j
     If j > UBound(iZeile) Then
        iNotfound = iNotfound + 1
        ThisWorkbook.Worksheets("Nicht gefunden").Rows(iNotfound).Value = .Rows(i).Value
     End If
  Next i
End With

' Formatieren der Spaltenbreite aller Tabellen
On Error Resume Next
For j = 0 To UBound(iZeile)
   Worksheets(sArrBlatt(j)).ListObjects(sArrList(1)).Columns.AutoFit
Next j

' Speed aus
With Application
   .ScreenUpdating = True
   .EnableEvents = True
   .Calculation = xlCalculationAutomatic
End With

MsgBox iAnz & " Zeilen wurden verarbeitet", vbInformation, "Datenübertragung"

End Sub