VBA Code Tabellenblatt erzeugen

[deschroe]

Hallo,

gerne würde ich für ein kleines Excel Tool von mir anpassen.
Aktuell nutze ich den folgenden Code, den ich mit viel Hilfe hier aus dem Forum für meine Zwecke abändern konnte:

Code:

Sub Bestelldatei()
Dim i As Long, boVorhanden As Boolean

Application.ScreenUpdating = False

For i = 1 To Worksheets.Count
   If Worksheets(i).Name = Worksheets("Bestand").Range("E4") Then
      boVorhanden = True
      With Worksheets(i)
          .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Sheets("Bestand").Range("B2").Value
          .Cells(.Rows.Count, 1).End(xlUp).Offset(, 1).Value = Sheets("Bestand").Range("F3").Value
          MsgBox "Hinzugefügt zu " & Worksheets("Bestand").Range("E4").Value
      End With
      Exit For
  End If
Next i

If Not boVorhanden Then
  Worksheets.Add after:=Sheets(3)
  ActiveSheet.Name = Worksheets("Bestand").Range("E4")
  ActiveSheet.Range("A1") = Worksheets("Bestand").Range("B2")
  ActiveSheet.Range("B1") = Worksheets("Bestand").Range("F3")
End If
 
End Sub

Dabei steht in B2 eine Artikelnummer und in F3 die Menge. Diese werden dann in ein neues Tabellenblatt geschrieben in A1 und B1.
Zusätzlich wird dem Tabellenblatt ein Name zugewiesen, der in Zelle E4 steht. Gibt es bereits ein Tabellenblatt mit dem Namen, so wird in dieses Tabellenblatt in die nächste Zeile geschrieben.

Mein Ziel ist es, dass eine weitere Abfrage hinzukommt, bei der überprüft wird, wenn M31 nicht leer ist, ein weiteres Tabellenblatt erstellt wird. Dies hat den Namen, der in E5 steht.
Zudem soll in A1 der Wert aus B2 stehen und außerdem anstatt F3 dann M31.

Auch hier gilt, ist das Tabellenblatt bereits vorhanden, soll in die nächste Zeile geschrieben werden.

Über Tipps wäre ich sehr dankbar.
Möglicherweise hat auch jemand für mich einige Literaturtipps. Gerne würde ich mich diesbezüglich weiterentwickeln.

[LuckyJoe]

Hallo,

du kannst die Wahrscheinlichkeit, dass dir im Forum geholfen wird, ungemein steigern, wenn du einen Beispieldatei beifügst

[Flotter Feger]

Hallo,

ich würde es so machen ...

PHP-Code:

Function WorkSheetExists(ByVal WS As Variant) As Boolean
On Error Resume Next
WorkSheetExists = Not Worksheets(WS) Is Nothing
End Function

Sub Bestelldatei()
Dim WS As Worksheet

Application.ScreenUpdating = False

If WorkSheetExists(Worksheets("Bestand").Range("E4")) Then
   Set WS = Worksheets(Worksheets("Bestand").Range("E4"))
Else
   Set WS = Worksheets.Add(after:=Worksheets(3))
   WS.Name = Worksheets("Bestand").Range("E4")
End If

With WS
   .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Sheets("Bestand").Range("B2").Value
   .Cells(.Rows.Count, 1).End(xlUp).Offset(, 1).Value = Sheets("Bestand").Range("F3").Value
   MsgBox "Hinzugefügt zu " & Worksheets("Bestand").Range("E4").Value
End With

If Worksheets("Bestand").Range("M31").Value <> "" Then
   If WorkSheetExists(Worksheets("Bestand").Range("E5")) Then
       Set WS = Worksheets(Worksheets("Bestand").Range("E5"))
   Else
       Set WS = Worksheets.Add(after:=Worksheets(3))
       WS.Name = Worksheets("Bestand").Range("E5")
   End If
   
   With WS
       .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Sheets("Bestand").Range("B2").Value
       .Cells(.Rows.Count, 1).End(xlUp).Offset(, 1).Value = Sheets("Bestand").Range("M31").Value
       MsgBox "Hinzugefügt zu " & Worksheets("Bestand").Range("E5").Value
   End With
End If

Application.ScreenUpdating = True
End Sub


[deschroe]

Hallo Sabrina,

vielen Dank schon einmal für deine Hilfe.

Leider funktioniert der Code noch nicht ganz.
Die Datei wird zwar erzeugt, allerdings werden die Werte jeweils in die zweite Zeile geschrieben.

Außerdem bekomme ich den Fehler, wenn die Datei bereits vorhanden ist, dass der Name bereits verwendet wird.
In diesem Fall sollte allerdings der Wert in die bereits vorhandene Tabelle eingefügt werden.

Über weitere Hilfe würde ich mich sehr freuen.

Danke

[Flotter Feger]

Hallo,

SABINA ... warum könnt ihr alle nicht lesen ???

Hatte ich auch noch nicht ... der Variant in der Function erzeugt einen Fehler in 2016 ... versuch es so ...

PHP-Code:

Function WorkSheetExists(ByVal WS As String) As Boolean
On Error Resume Next
WorkSheetExists = Not Worksheets(WS) Is Nothing
End Function

Sub Bestelldatei()
Dim WS As Worksheet

Application.ScreenUpdating = False

If WorkSheetExists(Worksheets("Bestand").Range("E4")) Then
   Set WS = Worksheets(Worksheets("Bestand").Range("E4").Value)
Else
   Set WS = Worksheets.Add(after:=Worksheets(3))
   WS.Name = Worksheets("Bestand").Range("E4")
End If

With WS
   .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Sheets("Bestand").Range("B2").Value
   .Cells(.Rows.Count, 1).End(xlUp).Offset(, 1).Value = Sheets("Bestand").Range("F3").Value
   MsgBox "Hinzugefügt zu " & Worksheets("Bestand").Range("E4").Value
End With

If Worksheets("Bestand").Range("M31").Value <> "" Then
   If WorkSheetExists(Worksheets("Bestand").Range("E5")) Then
       Set WS = Worksheets(Worksheets("Bestand").Range("E5").Value)
   Else
       Set WS = Worksheets.Add(after:=Worksheets(3))
       WS.Name = Worksheets("Bestand").Range("E5")
   End If
   
   With WS
       .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Sheets("Bestand").Range("B2").Value
       .Cells(.Rows.Count, 1).End(xlUp).Offset(, 1).Value = Sheets("Bestand").Range("M31").Value
       MsgBox "Hinzugefügt zu " & Worksheets("Bestand").Range("E5").Value
   End With
End If

Application.ScreenUpdating = True
End Sub


[deschroe]

Hallo Sabina,

erst einmal danke für deine Hilfe. Der Name Sabina war mir so nicht geläufig. Deshalb hat mein Kopf wohl auf das Bekannte zurückgegriffen.
Ab nun halte ich mich dran ;)

Dein Code funktioniert soweit. Allerdings werden die Werte immer in die zweite Zeile geschrieben.
Hast du hierfür noch eine Idee?

Viele Grüße

[Kuwer]

Hallo Sabina,

Hatte ich auch noch nicht ... der Variant in der Function erzeugt einen Fehler in 2016 ... versuch es so ...

das habe ich jetzt mal in meinem E2010 probiert. Das Problem hier ist, dass ohne .Value-Angabe E4 als Zelle und nicht als deren Inhalt interpretiert wird.
Das ist ein schönes Beispiel dafür, dass es nicht schadet, ".Value", auch wenn es die Default-Eigenschaft ist, mit anzugeben.

If WorkSheetExists(Worksheets("Bestand").Range("E4").Value) Then
   Set WS = Worksheets(Worksheets("Bestand").Range("E4").Value)

Gruß Uwe