Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Autofilter, kopieren in neues Blatt fehlerhaft

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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Autofilter, kopieren in neues Blatt fehlerhaft
01.12.2009 11:08:07
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
Gruß
Peter
Anzeige
AW: Autofilter, kopieren in neues Blatt fehlerhaft
01.12.2009 11:16:57
Günther
Peter, tausend Dank, läuft einwandfrei !!!!

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige