Per VBA von Worksheet in Tabelle kopiere

Private Sub WartungskarteErstellen_Click()
Dim i As Long, strSuche As String, loAnz As Long, z As Long
Application.ScreenUpdating = False
With Worksheets("WartungskarteErstellen")
For i = 12 To .Cells(.Rows.Count, "A").End(xlUp).Row
strSuche = ""
If UCase(.Cells(i, "B")) = "X" Then
loAnz = Len(.Cells(i, "A")) - Len(Replace(.Cells(i, "A"), " ", ""))
If loAnz > 0 Then
For z = 0 To loAnz
strSuche = strSuche & Split(.Cells(i, "A"), " ")(z) & "*"
Next z
strSuche = "*" & strSuche
Else
strSuche = "*" & .Cells(i, "A") & "*"
End If
Worksheets("Wartungsaufgaben").Range("A10:J" & Worksheets("Wartungsaufgaben") _
.Cells(Rows.Count, "F").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=strSuche
If Worksheets("Wartungsaufgaben").AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
With Worksheets("Wartungsaufgaben").AutoFilter.Range
.Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy
End With
With Worksheets("Wartungskarte").
.Cells(.Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:= _
xlPasteValues
End With
Else
MsgBox "Fehler: Es ist für " & .Cells(i, "A") & " keine Wartungsaufgabe  _
vorhanden."
End If
End If
Next i

                With Worksheets("Wartungskarte")
.Cells(.Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues