abarbeiten Makro nach Bedingungen

Hallo,
Bitte nicht lachen- meine eigenen VBA Versuche.
Die Makro_Blatt1 ; _Blatt2; _Blatt3 und _Blatt4 funktionieren, J E D O C H nur wenn ich sie einzeln auffrufe.
Allerdings läuft das Gesamte Makro immer von vorn bis zum Schluß ab, es soll aber immer nur das eine Makro abgearbeitet werden, wenn die Bedingungen erfüllt sind.
Habe die einzelnen Makros bereite in


Sub Makro_Blattwahl  eingearbeitet.
Nun sollen aber immer nur eines ausgeführt werden, und zwar wenn:
für Makro_Blatt1  wenn in C5 und D5  leer. dann Ausführung
für Makro_Blatt2  wenn in D5 und C25  ( da steht eine  Zahl "2")  befüllt  dann Ausfü _
hrung
für Makro_Blatt3  wenn in D5 und C43 ( da steht eine  Zahl "3") befüllt  dann Ausführung
für Makro_Blatt4  wenn in D5 und 62 ( da steht eine  Zahl "4") befüllt  dann Ausführung
Vieleicht kann man auch die Blatt Nr., mit einbeziehen.


Sub Makro_Blattwahl()
'für 1Blatt
If Range("C5") = "" And Range("D5") = "" Then Call Worksheets("Bearbeiten").Range("B4:D250"). _
ClearContents
Sheets("Bestand").Select
Range("B45:D55").Select
Selection.Copy
Sheets("Bearbeiten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurde 1 Blatt übertragen") = vbOK Then
Worksheets("Bearbeiten").Range("B:C").ClearContents 'dies nur als Test
End If
'für 4Blatt
If Range("D5")  "" And Range("C62")  "" Then Call Worksheets("Bearbeiten").Range("B4:D250"). _
ClearContents
Sheets("Bestand").Select
Range("B7:D20,B26:D39,B45:D58,B64:D74").Select
Selection.Copy
Sheets("Bearbeiten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurden 4 Blätter übertragen") = vbOK Then
Worksheets("Bearbeiten").Range("B:C").ClearContents 'dies nur als Test
End If
'für 3Blatt
If Range("D5")  "" And Range("D43")  "" Then Call Worksheets("Bearbeiten").Range("B4:D250") _
.ClearContents
Sheets("Bestand").Select
Range("B7:D20,B26:D39,B45:D55").Select
Selection.Copy
Sheets("Bearbeiten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurden 3 Blätter übertragen") = vbOK Then
Worksheets("Bearbeiten").Range("B:C").ClearContents 'dies nur als Test
End If
'für 2Blatt
If Range("D5")  "" And Range("D24")  "" Then Call Worksheets("Bearbeiten").Range("B4:D250"). _
ClearContents
Sheets("Bestand").Select
Range("B45:D55,B26:D36").Select
Selection.Copy
Sheets("Bearbeiten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurden 2 Blätter übertragen") = vbOK Then
Worksheets("Bearbeiten").Range("B:C").ClearContents 'dies nur als Test
End If
End Sub

'folgende Makros funktionieren und dienen als Funktionsablauf

'diese sind oben in Makro_Blattwahl()einghearbeitet.


Sub Makro_Blatt1()
Worksheets("Bearbeiten").Range("B4:D250").ClearContents
Sheets("Bestand").Select
Range("B45:D55").Select
Selection.Copy
Sheets("Bearbeiten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurde 1 Blatt übertragen") = vbOK Then
Worksheets("Bearbeiten").Range("B:C").ClearContents  'dies nur als Test
End If
End Sub



Sub Makro_Blatt2()
Worksheets("Bearbeiten").Range("B4:D250").ClearContents
Sheets("Bestand").Select
Range("B45:D55,B26:D36").Select
Selection.Copy
Sheets("Bearbeiten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurden 2 Blätter übertragen") = vbOK Then
Worksheets("Bearbeiten").Range("B:C").ClearContents
End If
End Sub



Sub Makro_Blatt3()
Worksheets("Bearbeiten").Range("B4:D250").ClearContents
Sheets("Bestand").Select
Range("B7:D20,B26:D39,B45:D55").Select
Selection.Copy
Sheets("Bearbeiten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurden 3 Blätter übertragen") = vbOK Then
Worksheets("Bearbeiten").Range("B:C").ClearContents
End If
End Sub



Sub Makro_Blatt4()
Worksheets("Bearbeiten").Range("B4:D250").ClearContents
Sheets("Bestand").Select
Range("B7:D20,B26:D39,B45:D58,B64:D74").Select
Selection.Copy
Sheets("Bearbeiten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If MsgBox("Soll Bestand nun gelöscht werden?", _
vbOKCancel, "  Es wurden 4 Blätter übertragen") = vbOK Then
Worksheets("Bearbeiten").Range("B:C").ClearContents
End If
End Sub



kann jemand jelfen?

Grüße Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro_Blattwahl() 'für 1Blatt If Range("C5") = "" And Range("D5") = "" Then Call Makro_Blatt1 'für 4Blatt If Range("D5") "" And Range("C62") "" Then Call Makro_Blatt4 'für 3Blatt If Range("D5") "" And Range("D43") "" Then Call Makro_Blatt3 'für 2Blatt If Range("D5") "" And Range("D24") "" Then Call Makro_Blatt2 End Sub Sub Makro_Blatt1() Worksheets("Bearbeiten").Range("B4:D250").ClearContents Sheets("Bestand").Range("B45:D55").Copy Sheets("Bearbeiten").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False If MsgBox("Soll Bestand nun gelöscht werden?", vbOKCancel, " Es wurde 1 Blatt übertragen") = _ vbOK Then Worksheets("Bearbeiten").Range("B:C").ClearContents 'dies nur als Test End If End Sub Sub Makro_Blatt2() Worksheets("Bearbeiten").Range("B4:D250").ClearContents Sheets("Bestand").Range("B45:D55,B26:D36").Copy Sheets("Bearbeiten").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False If MsgBox("Soll Bestand nun gelöscht werden?", vbOKCancel, " Es wurden 2 Blätter übertragen") = _ vbOK Then Worksheets("Bearbeiten").Range("B:C").ClearContents End If End Sub Sub Makro_Blatt3() Worksheets("Bearbeiten").Range("B4:D250").ClearContents Sheets("Bestand").Range("B7:D20,B26:D39,B45:D55").Copy Sheets("Bearbeiten").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False If MsgBox("Soll Bestand nun gelöscht werden?", vbOKCancel, " Es wurden 3 Blätter übertragen") = _ vbOK Then Worksheets("Bearbeiten").Range("B:C").ClearContents End If End Sub Sub Makro_Blatt4() Worksheets("Bearbeiten").Range("B4:D250").ClearContents Sheets("Bestand").Range("B7:D20,B26:D39,B45:D58,B64:D74").Copy Sheets("Bearbeiten").Range("B4").Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False If MsgBox("Soll Bestand nun gelöscht werden?", vbOKCancel, " Es wurden 4 Blätter übertragen") = _ vbOK Then Worksheets("Bearbeiten").Range("B:C").ClearContents End If End Sub

Sub Makro_Blattwahl() Dim rng_Bereich As Range Dim obj_wks As Worksheet Set obj_wks = Sheets("Bestand") If Range("C5") = "" And Range("D5") = "" Then Call Makro_Blatt_Allgemein(obj_wks.Range("B45:D55"), 1) ElseIf Range("D5") "" And Range("C25") = 2 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B45:D55,B26:D36"), 2) ElseIf Range("D5") "" And Range("C43") = 3 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D39,B45:D55"), 3) ElseIf Range("D5") "" And Range("C62") = 4 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D39,B45:D58,B64:D74"), 4) End If End Sub Sub Makro_Blatt_Allgemein(rng_Bereich As Range, lng_Blatt As Long) Worksheets("Bearbeiten").Range("B4:D250").ClearContents rng_Bereich.Copy Sheets("Bearbeiten").Range("B4").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 Worksheets("Bearbeiten").Range("B:C").ClearContents End If End Sub

Sub Makro_Blattwahl_ganzneu() Dim rng_Bereich As Range Dim obj_wks As Worksheet Set obj_wks = Sheets("Bestand") If Range("C5") = "" And Range("D5") = "" Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D17"), 1) ElseIf Range("D5") "" And Range("D24") = 2 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D36"), 2) ElseIf Range("D5") "" And Range("D43") = 3 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D39,B45:D55"), 3) ElseIf Range("D5") "" And Range("D43") "" And Range("D62") = 4 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D39,B45:D58,B64:D74"), 4) End If End Sub Sub Makro_Blatt_Allgemein(rng_Bereich As Range, lng_Blatt As Long) Worksheets("Bearbeiten").Range("B4:D250").ClearContents rng_Bereich.Copy Sheets("Bearbeiten").Range("B4").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 Worksheets("Bearbeiten").Range("B:C").ClearContents End If End Sub 'habe noch mal die "Erkennung" der Blätter angepasst. 'Leider funktioniert alles nur bei 1 und 2 , also wenn 'Range("C5") = "" And Range("D5") = 1 inC5 --- beide leer--- i.O. ' es wird ein Blatt _ übertragen 'Range("D5") "" And Range("D24") = 2 in C5 Blatt in D24 nun eine 2 --- i.O. ' es werden zwei Blä _ tter übertragen 'NUN in 'Range ("D5") "" And Range("D43") = 3 in C5 Blatt in D43 nun eine 3 --- _ funktioniert nicht ' es werden nur zwei Blätter ü _ bertragen!! 'Range("D5") "" And Range("D43") "" And Range("D62") = 4 Blatt 'in C5 Blatt 'in D43 nun eine 3 'in D62 nun eine 4 -- _ - funktioniert nicht ' es werden nur zwei Blätter ü _ bertragen!!

If Range("D5") = 1 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D17"), 1) ElseIf Range("D24") = 2 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D36"), 2) ElseIf Range("D43") = 3 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D39,B45:D55"), 3) ElseIf Range("D62") = 4 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D39,B45:D58,B64:D74"), 4) End If

Guten Morgen
habe noch mal in der Datei alles hintrlegt.
https://www.herber.de/bbs/user/134351.xlsm
In diesem Blatt "Bestand" werden über ein anderes Makro "Blätter" eingefügt
die Vorlagen dazu sind in der Hilfstabelle
es wird jedoch nur ein Definierter Zellbereich dieser Blätter in "Bearbeiten", das ist meine Bearbeitungsoberfläche- gebraucht
da die eingefügten Blätter in "Bestand" wenn nur ein Blatt vorhanden , in C5 und D5 keine Werte, leer
wenn in "Bestand"zwei Blatt vorhanden , dann in C5 steht Blatt und in C5 die Zahl1 sowie in D24 eine 2
wenn in "Bestand"drei Blatt vorhanden , dann in C5 steht Blatt und in D5 eine 1; in D24 eine 2 und in D43 eine 3
wenn in "Bestand" vier Blatt vorhanden , dann in C5 steht Blatt und in D5 eine 1; in D24 eine 2 ; in D43 und in D 62 ein 4
ich wollte nun in Abhängikeit von D5 leer ; D24 mit 2; D43 mit 3 und D62 den bestimmten Zellinhalt von
bei 1Blatt vorhanden ("B7:D17"), 1) nach "Bearbeiten in ("B4") einfügen
bei 2 Blatt vorhanden ("B7:D20,B26:D36"), 2) nach "Bearbeiten in ("B4") einfügen
bei 3 Blatt voranden ("B7:D20,B26:D39,B45:D55"), 3) nach "Bearbeiten in ("B4") einfügen
bei 4 Blatt vorhanden ("B7:D20,B26:D39,B45:D58,B64:D74"), 4 nach "Bearbeiten in ("B4") einfügen
Danach soll mit MSG abgefragt werden, ob "Bestand" gelöscht werden soll.
darauf habe ich erst mal beim Test verzichtet, und habe zum Test eben die Spalten B un D gelöxscht, um die Funktion zu Prüfen
Funktion eben nur mit 1Blatt oder 2 Blatt- da funktionert der Code tadellos.
Gruß Andreas

If Range("C5") = "" And Range("D5") = "" Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D17"), 1) ElseIf Range("D5") "" And Range("D62") = 4 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D39,B45:D58,B64:D74"), 4) ElseIf Range("D5") "" And Range("D43") = 3 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D39,B45:D55"), 3) ElseIf Range("D5") "" And Range("D24") = 2 Then Call Makro_Blatt_Allgemein(obj_wks.Range("B7:D20,B26:D36"), 2) End If

Beliebteste Forumthreads (12 Monate)

abarbeiten Makro nach Bedingungen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread