Option Explicit
Sub Zusammenfassung()
Dim i, a, b As Integer
Dim tbl1, tbl2 As ListObject
Dim loLetzte As Integer
Set tbl1 = Worksheets("xxx").ListObjects("Tabelle13")
Set tbl2 = Worksheets("yyy").ListObjects("Tabelle14")
If tbl1.ListRows.Count >= 1 Then
tbl1.DataBodyRange.Delete
End If
If tbl2.ListRows.Count >= 1 Then
tbl2.DataBodyRange.Delete
End If
a = 1
b = 1
With Worksheets("GSV").ListObjects("Tabelle1").DataBodyRange
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To loLetzte
If .Cells(i, 2) = "xxx" Then
.Rows(i).Copy Destination:=Worksheets("xxx").Range(tbl1).Rows(a)
a = a + 1
End If
If .Cells(i, 2) = "yyy" Then
.Rows(i).Copy Destination:=Worksheets("yyy").Range(tbl2).Rows(b)
b = b + 1
End If
Next i
End With
End Sub