Office: Suche Hilfe bei einem VBA Code --> Prüfen ob Zelle Leer, dann Makro ausführen

Hallo,

suche mal wieder Hilfe bei einem Code. Und zwar möchte ich eine Abfrage einbauen, ob eine Zelle Leer ist, und wenn sie leer ist dann mit dem code weitermachen, wenn sie nicht leer ist, dann am ende meines codes weitermachen.

Hier der code. ich schreibe hinzu, was wann passieren soll


Sub Datenübernahme_Angebot()
ActiveSheet.Unprotect ("MHS")
Sheets("Angebot").Unprotect ("MHS")
Dim rngC As Range
Dim lngLZ As Long
Dim wskQuelle As Worksheet
Dim wskZiel As Worksheet
Set wskQuelle = Worksheets("Material & Kosten")
Set wskZiel = Worksheets("Angebot")
With wskZiel
lngLZ = WorksheetFunction.Max(16, .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
With wskQuelle
With .Range("C3:C" & .Rows.Count)
If WorksheetFunction.Count(.Cells) Then
For Each rngC In .SpecialCells(xlCellTypeConstants, xlNumbers)
lngLZ = lngLZ + 1
If rngC.Offset(, -2) <> Empty Then
wskZiel.Cells(lngLZ, 2).Resize(1, 5).Value = rngC.Offset(, -2).Resize(1, 5).Value
Else
wskZiel.Cells(lngLZ, 2).Value = rngC.Offset(, -2).End(xlUp).Value
wskZiel.Cells(lngLZ, 3).Resize(1, 5).Value = rngC.Offset(, -1).Resize(1, 5).Value
End If
Next
End If
End With
End With
Sheets("Angebot").Select
Range("F3") = Date

--> Nun soll die Abfrage kommen ob Zelle B8 leer ist, ist sie leer dann mit dem code (den 3 Inputboxen) weitermachen
Ist sie nicht leer, dann Abfrage ob zum ende des codes springen oder ab hier weitermachen. ich markiere unten wohin...

If Range(B8) <> "" Then


Dim strDate As String, strNewName As String
strDate = Format(Text)
strNewName = InputBox("Name des Kundens ?", , strDate)
If StrPtr(strNewName) = 0 Then Exit Sub
With Sheets("Angebot").Range("B8")
If IsEmpty(.Value) Then
.Value = strNewName
ElseIf MsgBox("Ein Wert ist schon vorhanden. Überschreiben?", vbYesNo) = vbYes Then
.Value = strNewName
End If
End With
strDate = Format(Text)
strNewName = InputBox("Straße des Kundens ?", , strDate)
If StrPtr(strNewName) = 0 Then Exit Sub
With Sheets("Angebot").Range("B9")
If IsEmpty(.Value) Then
.Value = strNewName
ElseIf MsgBox("Ein Wert ist schon vorhanden. Überschreiben?", vbYesNo) = vbYes Then
.Value = strNewName
End If
End With
strDate = Format(Text)
strNewName = InputBox("Postleitzahl & Ort des Kundens ?", , strDate)
If StrPtr(strNewName) = 0 Then Exit Sub
With Sheets("Angebot").Range("B10")
If IsEmpty(.Value) Then
.Value = strNewName
ElseIf MsgBox("Ein Wert ist schon vorhanden. Überschreiben?", vbYesNo) = vbYes Then
.Value = strNewName
End If
End With
strDate = Format(Date, "YYYY-")
strNewName = InputBox("Angebotsnummer ?", , strDate)
If StrPtr(strNewName) = 0 Then Exit Sub
With Sheets("Angebot").Range("C15")
If IsEmpty(.Value) Then
.Value = strNewName
ElseIf MsgBox("Ein Wert ist schon vorhanden. Überschreiben?", vbYesNo) = vbYes Then
.Value = strNewName
End If
End With



--> ggf. soll das makro hier weitermachen, wenn die zelle b8 nicht leer ist und die abfrage oben entsprechend beantwortet wurde..

Dim NeuerName As String
NeuerName = Range("C15") & " " & Range("B8")
ActiveWorkbook.SaveAs "\\CAMAHOMESERVER\Public\Computerservice Haas\Angebote ,Rechnungen & Aufträge\" & NeuerName
ActiveSheet.Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Sheets("Material & Kosten").Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End If

End Sub


Es wäre sehr nett, wenn mir jemand auf die sprünge helfen könnte, vielen Dank!

 

Hallo,

so aus dem Stegreif:
1. Den Code-Teil zwischen den Markierungen als separate Sub auslagern.
2. folgende Routine zwischen die beiden Markierungen:

Code:

If Range("B8") <> "" Then
   If MsgBox("Weitergehen?", vbYesNo) = vbYes Then
      Sub2
   End If
ElseIf Range("B8") = "" Then
   Sub2
End If

Gruß

Bosko

 

Hi,

vom Prinzip her so:

Code:

If Range("B8") <> "" Then
   Dim strDate As String, strNewName As String
   strDate = Format(Text)
   strNewName = InputBox("Name des Kundens ?", , strDate)
   If StrPtr(strNewName) = 0 Then Exit Sub
   With Sheets("Angebot").Range("B8")
      If IsEmpty(.Value) Then
         .Value = strNewName
      ElseIf MsgBox("Ein Wert ist schon vorhanden. Überschreiben?", vbYesNo) = vbYes Then
         .Value = strNewName
      End If
   End With
   strDate = Format(Text)
   strNewName = InputBox("Straße des Kundens ?", , strDate)
   If StrPtr(strNewName) = 0 Then Exit Sub
      With Sheets("Angebot").Range("B9")
         If IsEmpty(.Value) Then
         .Value = strNewName
      ElseIf MsgBox("Ein Wert ist schon vorhanden. Überschreiben?", vbYesNo) = vbYes Then
         .Value = strNewName
      End If
   End With
   strDate = Format(Text)
   strNewName = InputBox("Postleitzahl & Ort des Kundens ?", , strDate)
   If StrPtr(strNewName) = 0 Then Exit Sub
   With Sheets("Angebot").Range("B10")
      If IsEmpty(.Value) Then
         .Value = strNewName
      ElseIf MsgBox("Ein Wert ist schon vorhanden. Überschreiben?", vbYesNo) = vbYes Then
         .Value = strNewName
      End If
   End With
   strDate = Format(Date, "YYYY-")
   strNewName = InputBox("Angebotsnummer ?", , strDate)
   If StrPtr(strNewName) = 0 Then Exit Sub
   With Sheets("Angebot").Range("C15")
      If IsEmpty(.Value) Then
         .Value = strNewName
      ElseIf MsgBox("Ein Wert ist schon vorhanden. Überschreiben?", vbYesNo) = vbYes Then
         .Value = strNewName
      End If
   End With
Else
   Dim NeuerName As String
   NeuerName = Range("C15") & " " & Range("B8")
   ActiveWorkbook.SaveAs "\\CAMAHOMESERVER\Public\Computerservice Haas\Angebote ,Rechnungen & Aufträge\" & NeuerName
   ActiveSheet.Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
   ActiveSheet.EnableSelection = xlUnlockedCells
   Sheets("Material & Kosten").Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
   ActiveSheet.EnableSelection = xlUnlockedCells
End If

Was bedeutet diese Codezeile strDate = Format(Text)?? Ist Text eine Vatiable? oder meinst du strDate = Format(Date, "@") - also Datum als Text-Format?

Bis später,
Karin

 

Ok vielen Dank, ich probiers mal ob ich es hin bekomme!

Gruß

 

Hallo Karin,

hier werden daten aus einem Blatt in ein anderes übertragen. Das hat mit datum eigentlich nichts zu tun.
Nur der Text soll undanhängig von Textgröße und Format übertragen weden. Das Makro funktionierte auch immer sehr gut.

Vielen Dank!

 

Also Bosko,

mit deiner Version komme ich nicht wirklich so zurecht..

Karin bei deiner Version kann in B8 was stehen oder nicht, die Box kommt nicht.

Vielen Dank für eure Mühen, könnt Ihr nochmals drüber schauen? Danke!

 

Hi,

kann ich nicht nachvollziehen - in meiner nachgebauten Arbeitsmappe kommt die InputBox sofort, wenn sowohl in der aktiven Tabelle Zelle B8 als auch in Tabelle "Angebot" Zelle B8 nicht leer sind.

Bis später,
Karin