HERBERS Excel-Forum - das Archiv
Thema: Autofilter, kopieren in neues Blatt fehlerhaft | Herbers Excel-Forum
Autofilter, kopieren in neues Blatt fehlerhaft
Günther
Guten Morgen,
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
AW: Autofilter, kopieren in neues Blatt fehlerhaft
Peter
Hallöchen Günther,
versuche mal folgendes:
Sub zus_TED()
' fasst alle TED auf einem seperaten Blatt zusammen
Application.ScreenUpdating = False
Sheets("Personal_Erfassungsblatt").Activate
ActiveSheet.Unprotect
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
Range("A1").Select
Selection.AutoFilter Field:=7, Criteria1:="TED"
anzahl = WorksheetFunction.CountIf(Columns("g:g"), "Ted")
If anzahl = 0 Then
MsgBox ("Keine Teds vorhanden")
Goto weiter:
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
weiter:
end if
End Sub
Peter
AW: Autofilter, kopieren in neues Blatt fehlerhaft
Günther
Peter, tausend Dank, läuft einwandfrei !!!!
Excel-Beispiele