Autofilter, kopieren in neues Blatt fehlerhaft
Günther
mit folgendem Code prüfe ich, ob der Eintrag "TED" vorkommt, lasse dann entsprechend filtern und in das eigene Blatt TED kopieren.
Funktioniert aber nur, wenn tatsächlich ein TED-Eintrag besteht. Ist keiner vorhanden kopiert _ es ALLE Datensätze. Kann man hier evtl. mit einer IF THEN was machen? Wie kann ich explizit angeben, dass nur TED kopiert werden und wenn kein TED vorhanden ist, das Ding einen exit
Sub macht?
Sub zus_TED()
' fasst alle TED auf einem seperaten Blatt zusammen
Application.ScreenUpdating = False
Sheets("Personal_Erfassungsblatt").Activate
ActiveSheet.Unprotect
Range("A1").Select
Selection.AutoFilter Field:=7, Criteria1:="TED"
If Range("A3") = "" Then
Exit Sub
Else
Range("A3:AK303").Copy
Sheets("TED").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Personal_Erfassungsblatt").Activate
ActiveSheet.Range("A1").Select
ActiveSheet.Unprotect
Selection.AutoFilter
ActiveSheet.Protect
End If
End Sub
Habt Dank