Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Autofilter, kopieren in neues Blatt fehlerhaft | Herbers Excel-Forum


Betrifft: Autofilter, kopieren in neues Blatt fehlerhaft von: Günther
Geschrieben am: 01.12.2009 10:46:45

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

  

Betrifft: AW: Autofilter, kopieren in neues Blatt fehlerhaft von: Peter Rücker
Geschrieben am: 01.12.2009 11:08:07

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


  

Betrifft: AW: Autofilter, kopieren in neues Blatt fehlerhaft von: Günther
Geschrieben am: 01.12.2009 11:16:57

Peter, tausend Dank, läuft einwandfrei !!!!


Beiträge aus den Excel-Beispielen zum Thema "Autofilter, kopieren in neues Blatt fehlerhaft"