MSG Box mit Abfrage einbinden - Sheet ohne Hinweis Löschen

Guten Abend,
Nun habe ich den Code zum laufen gebracht und nach meinen Wünschen angepasst.
er läuft noch nicht ganz rund.
folgendes würde ich noch einbauen- damit das Makro nicht immer mit Fehler stoppt.
*zuerst Abfrage: ob überhaupt das Sheet "Bestand" existiert
---> ja dann Makro ausführen / wenn nein dann Makro ohne Hinweis ignorieren
* am Schluß MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, " Es wurden " & lng_Blatt & " Blätter übertragen") = vbOK Then
also Anzahl der übertragenen Blätter Anzeigen --das funktioniert--
und Frage ob " Blatt Bestand" nun gelöscht werden soll
"oK" dann Löschen´ohne weiteren Hinweis und in Blatt "Bearbeiten zu A4 springen
"nein" dann im Blatt Bestand zur letzten ausgefüllten Zeile springen.
geht dies einzuarbeiten?
Möchte das Makro nicht unbedingt zerstören vor allem mit den Löschen von Sheets bin ich etwas vorsichtig.
Kann jemand helfen?
LG Andreas

Option Explicit

Sub Makro_Blattwahl_ganzneu()
Dim rng_Bereich As Range
Dim obj_wks As Worksheet
Sheets("Bestand").Select
Set obj_wks = Sheets("Bestand")
If Range("O7") = "" And Range("P7") = "" Then
Call Makro_Blatt_Allgemein(obj_wks.Range("A26:Q46"), 1)
ElseIf Range("O7")  "" And Range("P167") = 4 Then
Call Makro_Blatt_Allgemein(obj_wks.Range("A26:Q55,A69:Q108,A121:Q149,A173:Q201"), 4)
ElseIf Range("O7")  "" And Range("P115") = 3 Then
Call Makro_Blatt_Allgemein(obj_wks.Range("A26:Q55,A69:Q108,A121:Q149"), 3)
ElseIf Range("O7")  "" And Range("P63") = 2 Then
Call Makro_Blatt_Allgemein(obj_wks.Range("A26:Q55,A69:Q97"), 2)
End If
End Sub

Sub Makro_Blatt_Allgemein(rng_Bereich As Range, lng_Blatt As Long)
Worksheets("Bearbeiten").Range("A4:Q250").ClearContents
rng_Bereich.Copy
Sheets("Bearbeiten").Range("A4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurden " & lng_Blatt & " Blätter übertragen") = vbOK Then
Application.DisplayAlerts = True
End If
Sheets("Bearbeiten").Select
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro_Blattwahl_ganzneu() Dim rng_Bereich As Range Dim obj_wks As Worksheet If WorkSheetExists("Bestand") = False Then Exit Sub End If Set obj_wks = Sheets("Bestand") With obj_wks If .Range("O7") = "" And .Range("P7") = "" Then Call Makro_Blatt_Allgemein(.Range("A26:Q46"), 1) ElseIf .Range("O7") "" And .Range("P167") = 4 Then Call Makro_Blatt_Allgemein(.Range("A26:Q55,A69:Q108,A121:Q149,A173:Q201"), 4) ElseIf .Range("O7") "" And .Range("P115") = 3 Then Call Makro_Blatt_Allgemein(.Range("A26:Q55,A69:Q108,A121:Q149"), 3) ElseIf .Range("O7") "" And .Range("P63") = 2 Then Call Makro_Blatt_Allgemein(.Range("A26:Q55,A69:Q97"), 2) End If End With End Sub Sub Makro_Blatt_Allgemein(rng_Bereich As Range, lng_Blatt As Long) Worksheets("Bearbeiten").Range("A4:Q250").ClearContents rng_Bereich.Copy Sheets("Bearbeiten").Range("A4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False If MsgBox("Soll Bestand nun gelöscht werden?", _ vbOKCancel, " Es wurden " & lng_Blatt & " Blätter übertragen") = vbOK Then Application.DisplayAlerts = False Sheets("Bestand").Delete Application.DisplayAlerts = True Sheets("Bearbeiten").Activate Range("A4").Select Else Sheets("Bestand").Activate Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Select ' springt auf die letzte gefüllte zelle _ in Spalte A End If End Sub Public Function WorkSheetExists(ByVal strName As String) As Boolean On Error Resume Next WorkSheetExists = Not Worksheets(strName) Is Nothing End Function

Beliebteste Forumthreads (12 Monate)

MSG Box mit Abfrage einbinden - Sheet ohne Hinweis Löschen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread