Bereich auswählen im Auto.Filter
26.10.2020 09:40:12
Lizzel
ich verzweifle langsam.
Über einen Suchbegriff durchforste ich ein Archiv (Wartungsaufgaben) nach allen notwendigen Aufgaben. Diesen Suchbegriff hab ich Spalte A gepackt und die Aufgaben stehen dahinter in B:J. Wurde der Begriff gefunden, wird mir die Zeile in ein neues Blatt kopiert.
Ich hab jetzt das Problem, dass mein Suchbegriff mitkopiert wird und ich das aber nicht will/benötige.
Wie und wo kann ich den Code ändern, dass nur B:J kopiert/ausgewählt wird?
Danke für euer Feedback/Zeit
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).Resize(.Rows.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
Worksheets("Wartungsaufgaben").Range("A10").AutoFilter