Neue Blätter nach Liste generieren

Sub schon *Siehe unten* Nun komme ich nicht weiter: Ich brauche einen oder mehrere Subs, wo der Inhalt aus einem anderen Blatt in alle erstellten _ Blätter eingefügt wird. Da aber sind zwischendurch Zellen, die auf Zellen in der Liste zugreifen und dort Werte rausholen z.B. "Liste!I4" Diese Befehle variieren sich natürlich bei jeder Rechnung und so muss sich das auch ändern :/ _ Vielen Dank schon mal für die Hilfe! :) Liebe Grüße, Juri Das Beispiel https://www.herber.de/bbs/user/93904.xls Sub FuegeBlaetterMitNamenEin() Dim Bereich As String Dim Zelle As Range Dim Tabelle As Worksheet Bereich = "a5:a30" With ActiveWorkbook For Each Zelle In ActiveSheet.Range(Bereich).Cells Set Tabelle = .Sheets.Add(after:=.Sheets(Sheets.Count)) Tabelle.Name = Zelle.Text Next Zelle End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Juri,
verwende in dem Blatt in das die Daten übernommen werden sollen, außer für die Rechnungsnummer, Formeln mit der Funktion SVERWEIS.
z.B. in Zelle A13: =SVERWEIS($B$26;Liste!$A:$O;4;FALSCH)
Dann musst du im Makro nur in Zelle B26 die Formel anpassen bzw. die Rechnungs-Nr. eintragen lassen.
Benenne das 2. Blatt in deiner Datei um in "Muster".
Mit den folgenden Anpassungen im Makro funktioniert es dann das Einfügen der Blätter und die Anpassung der Formel in B26 der eingefügten Blätter.
Das Musterblatt kann man auf Wunsch wieder ausblenden.
Gruß
Franz

Sub FuegeBlaetterMitNamenEin()
Dim Bereich As Range
Dim Zelle As Range
Dim Tabelle As Worksheet
With ActiveWorkbook.Worksheets("Liste") 'ActiveSheet
'Bereich mit Rechnungs-Nr. in Spalte A : A4:Axxx
Set Bereich = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets("Muster")
If .Visible  xlSheetVisible Then .Visible = xlSheetVisible
End With
With ActiveWorkbook
For Each Zelle In Bereich.Cells
'Muster-Tabelle kopieren und am Ende anfügen
.Sheets("Muster").Copy after:=.Sheets(Sheets.Count)
Set Tabelle = ActiveSheet
'Tabelle umbenennen
Tabelle.Name = Zelle.Text
'Rechnungs-Nr. eintragen bzw. Formel eintragen
'      Tabelle.Range("B26").Value = Zelle.Text
Tabelle.Range("B26").FormulaR1C1 = "='" & Zelle.Parent.Name & "'!R" & Zelle.Row & "C1"
Next Zelle
Application.ScreenUpdating = True
If MsgBox("Musterblatt wieder ausblenden?", vbQuestion + vbOKCancel + vbDefaultButton2, _
"Musterblatt ausblenden") = vbOK Then
ActiveWorkbook.Worksheets("Muster").Visible = xlSheetHidden
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Neue Blätter nach Liste generieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread