Microsoft Excel

Herbers Excel/VBA-Archiv

Tabellenblätter variabel erstellen

Betrifft: Tabellenblätter variabel erstellen von: David
Geschrieben am: 13.08.2020 12:48:17

Hallo zusammen,

habe ein Tabellenblatt ("Anfrage") auf welchem Farben, Farbnummern und Farbzuschnitte eingetragen werden können.
Die Farbnamen stehen in D33:M33, die Nummern in der Zeile darüber D32:M32 und die Infos über die Zuschnitte
(ZS1 - 4) in E, G, I und K94, 96 und 98.
Desweiteren gibt es noch die Tabellenblätter "ÜB", "MAT" und "FERT".

Habe auch mal eine Dummydatei erstellt, welche das ganze veranschaulicht. Diese Datei ist natürlich sehr abgespeckt, aber die wichtigsten Inhalte stehen an der selben Stelle wie im Original später auch.

-> https://www.herber.de/bbs/user/139605.xlsx

Nun folgender Sachverhalt, es soll wie folgt ablaufen:

1. Der Ausgangspunkt ist das Blatt "Anfrage". Hier wird zuerst die Anzahl der Farben
(entweder Farbname oder Farbnummer, geht beides) geprüft (maximal zehn Farben) und die Anzahl der Zuschnitte (maximal vier)

2. Wenn die Anzahl der Zuschnitte und Farben festgestellt wurde, werden die Tabellenblätter ("ÜB", "MAT" und "FERT")
für jede Farbe kopiert und für jeden Zuschnitt. Sprich in der Dummydatei sind es zwei Farben (rot und grün) und jeweils vier Zuschnitte.
Zuerst sollen die drei Blätter für die Farbe rot für jeden Zuschnitt kopiert und erstellt werden, sprich es gibt nachher 12 Tabellenblätter für die Farbe rot (4x "ÜB", 4x "MAT" und 4x "FERT")
Anschließend sollen die Tabellenblätter wie folgt benannt werden:

"Name des Tabellenblattes (ÜB; MAT; FERT) - Farbnummer - Zuschnitt"

Eventuell etwas schwer erklärt von mir, daher hier mal das komplette Beispiel für die Farbe grün der Dummydatei:

"ÜB - 93645 - ZS1", "MAT - 93645 - ZS1", "FERT - 93645 - ZS1"
"ÜB - 93645 - ZS2", "MAT - 93645 - ZS2", "FERT - 93645 - ZS2"
"ÜB - 93645 - ZS3", "MAT - 93645 - ZS3", "FERT - 93645 - ZS3"
"ÜB - 93645 - ZS4", "MAT - 93645 - ZS4", "FERT - 93645 - ZS4"

-> Dieses Spiel sollte nun für die anderen Farben ebenfalls vorgenommen werden.
-> In der Dummydatei sind die bereits vorhandenen Tabellenblätter grün eingefärbt, die Blätter, welche erstellt werden sollen, sind leicht orange hervorgehoben.

3. Es sollen jeweils die €-Werte der Zuschnitte aus der "Anfrage" in die entsprechenden Blätter "ÜB" kopiert werden.
Sprich der Wert aus E94 ("Anfrage") soll bei "ÜB - 93645 - ZS1" in E61 kopiert werden, der Wert aus G94 in "ÜB - 93645 - ZS2" usw.

Folgenden Code habe ich bereits (das hat bisher nur die Tabellenblätter entsprechend der
Anzahl der Farbnamen kopiert und erstellt)

Sub kurzerQuellcode()

Application.ScreenUpdating = False

    Dim wsAnfrage As Worksheet, wsUeb, wsMat, wsFert
    Dim rng As Range
    
   Set wsAnfrage = ThisWorkbook.Worksheets("Anfrage")

    set wsUeb = ThisWorkbook.Worksheets("ÜB")

    Set wsMat = ThisWorkbook.Worksheets("MAT")

    Set wsFert = ThisWorkbook.Worksheets("FERT")

    For Each rng In wsAnfrage.Range("D33:M33")
    If Not IsEmpty(rng) Then
    
    wsUeb.Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = wsUeb.Name & " " & rng.Text
    
    wsMat.Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = wsMat.Name & " " & rng.Text
    
    wsFert.Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = wsFert.Name & " " & rng.Text
    End If
Next rng

Sheets("Anfrage").Select
Application.ScreenUpdating = True
    
End Sub
Ich hoffe Ihr habt mein Anliegen einigermaßen verstanden und es kann mir jemand weiterhelfen.
Falls noch Unklarheiten oder Fragen sind, gerne melden.

Vorab vielen Dank!
David

Betrifft: AW: Tabellenblätter variabel erstellen
von: fcs
Geschrieben am: 13.08.2020 16:39:44

Hallo David,

ich dir die notwendige 2. For-Next-Schleife für Einlesen und Verarbeitung der Zuschnittsdaten in dein Makro eingebaut.
Zusätzlich wird der Berechnungsmodus vorübergehend auf manuell gesetzt, um das Makro nicht auszubremsen.

LG
Franz
Sub AnfrageBlaetterKopieren()
    Dim wsAnfrage As Worksheet, wsUeb As Worksheet, wsMat As Worksheet, wsFert As Worksheet
    Dim rng As Range
    Dim spaZS As Long, zeiZS As Long, StatusCalc As Long
    Dim strZS As String, dblEuro As Double, dblStueck As Double, varZS_Nr As Variant
    Dim wsZiel As Worksheet
    

    With Application
      .ScreenUpdating = False
      StatusCalc = .Calculation
      .Calculation = xlCalculationManual
    End With
    
    Set wsAnfrage = ThisWorkbook.Worksheets("Anfrage")

    Set wsUeb = ThisWorkbook.Worksheets("ÜB")

    Set wsMat = ThisWorkbook.Worksheets("MAT")

    Set wsFert = ThisWorkbook.Worksheets("FERT")
    
    zeiZS = 92 'Zeile mit Zuschnitt-Nummern
    For Each rng In wsAnfrage.Range("D33:M33")
    If Not IsEmpty(rng) Then
      For spaZS = 5 To 11 Step 2
        strZS = wsAnfrage.Cells(zeiZS, spaZS).Value
        If strZS <> "" Then
          dblEuro = wsAnfrage.Cells(zeiZS + 2, spaZS).Value
          dblStueck = wsAnfrage.Cells(zeiZS + 4, spaZS).Value
          varZS_Nr = wsAnfrage.Cells(zeiZS + 6, spaZS).Value
          wsUeb.Copy after:=Sheets(Sheets.Count)
          Set wsZiel = ActiveSheet
          With wsZiel
            .Name = wsUeb.Name & " - " & rng.Offset(-1, 0).Text & " - " & strZS
            .Range("E61").Value = dblEuro
          End With
          wsMat.Copy after:=Sheets(Sheets.Count)
          ActiveSheet.Name = wsMat.Name & " - " & rng.Offset(-1, 0).Text & " - " & strZS
        
          wsFert.Copy after:=Sheets(Sheets.Count)
          ActiveSheet.Name = wsFert.Name & " - " & rng.Offset(-1, 0).Text & " - " & strZS
        End If
      Next spaZS
    End If
    Next rng

    Sheets("Anfrage").Select
    
    With Application
      .ScreenUpdating = True
      .Calculation = StatusCalc
    End With
    
End Sub


Betrifft: AW: Tabellenblätter variabel erstellen
von: David
Geschrieben am: 13.08.2020 18:27:02

Hallo Franz,

muss es jetzt mal nochmal ausgiebig testen, aber auf Anhieb sieht das schon mal sehr gut aus!
Tausend Dank schon ein mal!!!

Gruß
David

Betrifft: AW: Tabellenblätter variabel erstellen
von: David
Geschrieben am: 13.08.2020 18:32:16

Habe noch eine Frage, für den Fall, dass noch mehr Daten aus "Anfrage" kopiert und an eine bestimmte Stelle kopiert werden müssen, nehme ich das hier

.Name = wsUeb.Name & " - " & rng.Offset(-1, 0).Text & " - " & strZS
.Range("E61").Value = dblEuro

und mache einfach bei .Range () die entsprechende Zelle und dann bei = entweder dblStueck oder varZS_Nr? Oder habe ich das falsch verstanden?

Betrifft: AW: Tabellenblätter variabel erstellen
von: fcs
Geschrieben am: 13.08.2020 22:41:58

Hallo David,

für das Übertragen der Werte hast du jetzt verschiedene Möglichkeiten

1. Wert in eine Variable einlesen, dann im Zielblatt in Zelle eintragen
.Range("xy11").Value = dblEuro

2. direkt Wert aus "Anfrage" in eine Zelle im Zielblatt eintragen, Verwendung Cells
.Range("xy11").Value = wsAnfrage.Cells(Zeile, Spalte).Value

3. direkt Wert aus "Anfrage" in eine Zelle im Zielblatt eintragen, Verwendung Range
.Range("xy12").Value = wsAnfrage.Range("A45").Value
größere zusammenhängende Zellbereiche kann man natürlich auch kopieren
wsAnfrage.Range("A15:D18").Copy
.Range("XY14").PasteSpecial Paste:=xlPasteValues
LG
Franz

Betrifft: AW: Tabellenblätter variabel erstellen
von: David
Geschrieben am: 14.08.2020 11:36:17

Hallo Franz,

ich habe nun deinen Code getestet, funktioniert einwandfrei. Nur eine Kleinigkeit sollte noch ergänz werden und zwar soll der Code wenn beispielsweise ZS3 (I94) und ZS4 (K94) nicht ausgefüllt sind nur ZS1 und ZS2 für die Farben erstellen soll. Also wenn quasi ne leere Stelle vorhanden ist, soll der Code hier aufhören.

LG
David

Betrifft: AW: Tabellenblätter variabel erstellen
von: fcs
Geschrieben am: 14.08.2020 12:21:49

Hallo David,

diese Prüfung hatte ich in weiser Voraussicht schon eingebaut.
      For spaZS = 5 To 11 Step 2
        strZS = wsAnfrage.Cells(zeiZS, spaZS).Value
        If strZS <> "" Then
Einfach mal etwas genauer gucken, was denn alles im Code steht oder einfach mal probieren, was passiert, wenn du einen Zuschnitt weglässt.

LG
Franz

Betrifft: AW: Tabellenblätter variabel erstellen
von: David
Geschrieben am: 14.08.2020 14:07:51

Hallo Franz,

das habe ich gesehen, aber dann mache ich offensichtlich etwas falsch. Habe jetzt mal "nur" Daten bei ZS1 und ZS2 eingetragen und ZS3 und 4 sind komplett leer, es werden allerdings die Blätter trotzdem komplett für ZS1 bis ZS4 erstellt.

zeiZS = 92 'Zeile mit Zuschnitt-Nummern

Habe hier mal die 92 zu einer 94 abgeändert, da ja hier nachher die Infos stehen. Hätte dann funktioniert, allerdings wäre dann der Tabellenname falsch.

Bin leider mit VBA nicht so wirklich vertraut, dass ich das selber lösen kann :X

Vielen Dank!
LG
David

Betrifft: AW: Tabellenblätter variabel erstellen
von: fcs
Geschrieben am: 14.08.2020 15:12:38

Hallo David,

ich habe keine Ahnung, warum es bei dir nicht funktioniert.

bei mir sieht es so aus, wenn ich z.B. die Zellen G92 und I92 leer lasse.

Wie du siehst werden nur Tabellenblätter für ZS1 und ZS4

Wenn ZS1 bis ZS4 in Zeile 92 im Blatt stehen bleiben sollen und du nur ggf. die Werte darunter in den Zeilen 94, 96 und 98 nicht einträgst, dann ändere die If-Zeile wie folgt ab:
        If wsAnfrage.Cells(zeiZS + 2, spaZS).Text <> "" Then 'prüft, ob EURO-Betrag eingetragen  _
is
LG
Franz

Betrifft: AW: Tabellenblätter variabel erstellen
von: David
Geschrieben am: 14.08.2020 15:34:24

Hallo Franz,

ich habe nun mal ein wenig an dem Code herumgebastelt und es funktioniert nun.

Jetzt müssen allerdings noch weitere Daten verknüpft bzw kopiert werden.
Hierfür habe ich eine Frage, da ich diese Formeln bzw Verknüpfungen ich zuerst ein mal selber versuchen möchte zu programmieren.
Ich benötige weitere for-Schleifen, da die Werte oftmals abhängig von den Farben ist. Ich habe nun den Code um folgende Zeilen ergänzt

' For i = 4 To 14
For spaZS = 5 To 11 Step 2
nameSZ = wsAnfrage.Cells(zeiZS, spaZS).Value
strZS = wsAnfrage.Cells(bezZS, spaZS).Value
If strZS <> "" Then

' euro = ws.Anfrage.Cells(zielpreis, i)
' gewinn = ws.Anfrage.Cells(gewinnZS, i)
dblEuro = wsAnfrage.Cells(zeiZS + 2, spaZS).Value
dblStueck = wsAnfrage.Cells(zeiZS + 4, spaZS).Value
varZS_Nr = wsAnfrage.Cells(zeiZS + 6, spaZS).Value
wsUeb.Copy after:=Sheets(Sheets.Count)
Set wsZiel = ActiveSheet
With wsZiel
.Name = wsUeb.Name & " - " & rng.Offset(-1, 0).Text & " - " & nameSZ
.Range("E61").Value = dblEuro

.Range("M8").Value = rng.Offset(-1, 0).Text

' .Range("H101").Value = euro
' .Range("P108").Value = gewinn
End With
wsMat.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = wsMat.Name & " - " & rng.Offset(-1, 0).Text & " - " & nameSZ

wsFert.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = wsFert.Name & " - " & rng.Offset(-1, 0).Text & " - " & nameSZ
End If
' Next i
Next spaZS
End If


Next rng


i wurde zuvor noch als Long definiert.
Beim Versuch den Code laufen zu lassen kommt die Fehlermeldung, dass ein ungültiger Verweis auf eine Next-Steuervariable vorliegt.

Es hängt mit meinem Versuch der i-for-Schleife einzubauen zusammen, allerdings weiß ich nicht, wie man das lösen kann :X

LG
David

Betrifft: AW: Tabellenblätter variabel erstellen
von: fcs
Geschrieben am: 14.08.2020 21:07:16

Hallo David,

bei längeren For-Next-Schleifen schreibe ich meistens die Zählvariable, die Nach For steht auch hinter das zugehörige Next. Das erleichtert ggf. die Lesbarkeit des Codes.

Man kann die Variable nach Next aber auch weglassen.
in deinem Fall hätte die 1. For-Next-Schleife den Zähler i, die 2. spaZS

Die Next-Anweisungen hat du dann in der falschen Reihefolge.
End If
' Next i
Next spaZS

musst du ändern in
End If
Next spaZS
Next i

oder du lässt die Variablen einfach weg.

LG
Franz

Betrifft: AW: Tabellenblätter variabel erstellen
von: David
Geschrieben am: 16.08.2020 13:26:31

Hallo Franz,

ich befürchte ich habe in deinem Code etwas kaputt gemacht :X

zeiZS = 92 'Zeile mit Zuschnitt-Nummern
For Each rng In wsAnfrage.Range("D33:M33")
bezZS = 94
spaSu = 50 'Zeile für die Gesamtsumme
spaPr = 55 'Zeile für den Preis
spaGE = 56 'Zeile für den Gewinn

If Not IsEmpty(rng) Then


For i = 4 To 14
For spaZS = 5 To 11 Step 2

strZS = wsAnfrage.Cells(zeiZS, spaZS).Value
If wsAnfrage.Cells(zeiZS + 2, spaZS).Text <> "" Then 'prüft, ob EURO-Betrag eingetragen is
dblEuro = wsAnfrage.Cells(zeiZS + 2, spaZS).Value
dblStueck = wsAnfrage.Cells(zeiZS + 4, spaZS).Value
varZS_Nr = wsAnfrage.Cells(zeiZS + 6, spaZS).Value
wsUeb.Copy after:=Sheets(Sheets.Count)
Set wsZiel = ActiveSheet
With wsZiel
.Name = wsUeb.Name & " - " & rng.Offset(-1, 0).Text & " - " & strZS
.Range("E61").Value = dblEuro
.Range("M8").Value = rng.Offset(-1, 0).Text
.Range("H10").Value = wsAnfrage.Cells(spaSu, i).Value
.Range("H101").Value = wsAnfrage.Cells(spaPr, i).Value
.Range("P108").Value = wsAnfrage.Cells(spaGE, i).Value


End With
wsMat.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = wsMat.Name & " - " & rng.Offset(-1, 0).Text & " - " & strZS

wsFert.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = wsFert.Name & " - " & rng.Offset(-1, 0).Text & " - " & strZS
End If
Next spaZS
Next i
End If
Next rng

Wenn ich den Code nun durchlaufen lasse,werden alle Tabellenblätter für die erste Farbe für alle Zuschnitte erstellt, sobald es aber zur zweiten Farbe gehen sollte, kommt die Fehlermeldung
"Laufzeitfehler 1004 Dieser Name wird bereits verwendet. Verwenden Sie einen anderen"

Für die zweite Farbe wird "ÜB (2)" erstellt und dann kommt die Fehlermeldung.

Vielen Dank!!

LG
David

Betrifft: AW: Tabellenblätter variabel erstellen
von: fcs
Geschrieben am: 18.08.2020 00:11:05

Hallo David,

du musst die i-Schleife innerhalb der spaZS-Schleife laufen lassen, damit die Blätter nicht 2 mal benannt werden.

Zusätzlich muss für die 3 Zellen in Spalte H, in die die Werte aus den Spalten i eingetragen werden ein Offset festgelegt werden, der bei jedem Durchlauf die Auszufüllende Zelle nach rechts oder unten verschiebt.

Noch ein Tip zur Benennung der Variablen:
z.B.
spaSu = 50 'Zeile für die Gesamtsumme
spaPr = 55 'Zeile für den Preis
spaGE = 56 'Zeile für den Gewinn
Da es sich um Zeilenwerte handelt sollten die Variable dann auch mit "zei" statt "spa" beginnen.

LG
Franz
  zeiZS = 92 'Zeile mit Zuschnitt-Nummern
  For Each Rng In wsAnfrage.Range("D33:M33")
    bezZS = 94
    spaSu = 50 'Zeile für die Gesamtsumme
    spaPr = 55 'Zeile für den Preis
    spaGE = 56 'Zeile für den Gewinn
    
    If Not IsEmpty(Rng) Then
      
      
      For spaZS = 5 To 11 Step 2
        
        strZS = wsAnfrage.Cells(zeiZS, spaZS).Value
        If wsAnfrage.Cells(zeiZS + 2, spaZS).Text <> "" Then 'prüft, ob EURO-Betrag eingetragen  _
is
          dblEuro = wsAnfrage.Cells(zeiZS + 2, spaZS).Value
          dblStueck = wsAnfrage.Cells(zeiZS + 4, spaZS).Value
          varZS_Nr = wsAnfrage.Cells(zeiZS + 6, spaZS).Value
          wsUeb.Copy after:=Sheets(Sheets.Count)
          Set wsZiel = ActiveSheet
          With wsZiel
            .Name = wsUeb.Name & " - " & Rng.Offset(-1, 0).Text & " - " & strZS
            .Range("E61").Value = dblEuro
            .Range("M8").Value = Rng.Offset(-1, 0).Text
            For i = 4 To 14
'              .Range("H10").Value = wsAnfrage.Cells(spaSu, i).Value
'              .Range("H101").Value = wsAnfrage.Cells(spaPr, i).Value
'              .Range("P108").Value = wsAnfrage.Cells(spaGE, i).Value
      'so werden die 11 Werte in die Zelle und die darunter liegenden Zellen eingetragen
              .Range("H10").Offset(i - 4, 0).Value = wsAnfrage.Cells(spaSu, i).Value
              .Range("H101").Offset(i - 4, 0).Value = wsAnfrage.Cells(spaPr, i).Value
              .Range("P108").Offset(i - 4, 0).Value = wsAnfrage.Cells(spaGE, i).Value
      'so werden die 11 Werte in die Zelle und die rechts daneben iegenden Zellen eingetragen
              .Range("H10").Offset(0, i - 4).Value = wsAnfrage.Cells(spaSu, i).Value
              .Range("H101").Offset(0, i - 4).Value = wsAnfrage.Cells(spaPr, i).Value
              .Range("P108").Offset(0, i - 4).Value = wsAnfrage.Cells(spaGE, i).Value
            Next i
          End With
          wsMat.Copy after:=Sheets(Sheets.Count)
          ActiveSheet.Name = wsMat.Name & " - " & Rng.Offset(-1, 0).Text & " - " & strZS
          
          wsFert.Copy after:=Sheets(Sheets.Count)
          ActiveSheet.Name = wsFert.Name & " - " & Rng.Offset(-1, 0).Text & " - " & strZS
        End If
      Next spaZS
    End If
  Next Rng


Betrifft: AW: Tabellenblätter variabel erstellen
von: Klaus
Geschrieben am: 19.08.2020 20:09:33

Hallo Franz,

danke für den Code, allerdings passt es noch nicht ganz. Ich vermute, ich habe mich falsch ausgedrückt...
Das Problem bzw der "Fehler" ist, dass der Code zuerst alle Felder für i (4 bis 14) durchgeht, bevor die nächsten Blätter erstellt werden. Allerdings muss quasi der Wert aus D50 in alle Blätter "ÜB" für jeden Zuschnitt der Farbe eins. Der Wert aus E50 muss dann in alle Blätter "ÜB" für jeden Zuschnitt der Farbe zwei etc.
Und bei dem aktuellen Code werden alle Werte aus D50:M50 in alle "ÜB" Blätter startend ab Zelle H10 nebeneinander rein kopiert.

Ich weiß leider nicht, wie man den "Fehler" beheben kann, damit die Werte aus beispielsweise D50:M50 in die richtigen Blätter zugeordnet werden.

LG und einen schönen Abend
David