Tabellenblätter einfügen und umbenennen

Hallo zusammen,
für eine Auswertung erstelle ich mehrer PivotTables. Dafür baue ich eine Basis und mag diese dann in verschiedene benannte Tabellenblätter einfügen. Bspw. kopiere ich eine PivotTable und erzeuge das Tabellenblatt A. Jetzt möchte ich nicht nur Tabellenblatt A sondern auch Tabellenblatt B,C,D,E,F... erzeugen. Ich habe schon einen Lösungsansatz per Liste gelesen, dass die Tabellenblattnamen in einem Sheet aufgelistet werden sollen und anschließend erstellt werden. Ich möchte allerdings die zu erzeugenden Namen ausschließlich im Code aufgelistet haben. Gibt es dafür bpsw. eine If Anweisung?
Mit folgendem Code arbeite ich zur Erstellung von Tabellenblatt A:


Sub CreatingA()
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim PT As PivotTable
Dim ws As Worksheet
Set ws = Worksheets("PivotTable")
'Blattname festlegen
BlattName = "A"
'Prüfen, ob das Blatt, welches eingefügt werden soll bereits vorhanden ist
'Nur einfügen, wenn Blatt noch nicht vorhanden ist
For Each blatt In Sheets
If blatt.Name = BlattName Then bolFlg = True
Next blatt
'Blatt nur einfügen, wenn noch nicht vorhanden
If bolFlg = False Then
With ThisWorkbook
.Sheets.Add After:=Sheets(Worksheets.Count)
.ActiveSheet.Name = "A"
End With
End If
Worksheets("PivotTable").PivotTables("Monatsauswertung").TableRange2.Copy Destination:=Worksheets("A").Range("B2")
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Für jede Hilfe bin ich sehr dankbar!
Grüße
Tobi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub aaa() Dim arrBlätter As Variant Dim i As Long, ws As Worksheet Application.ScreenUpdating = False arrBlätter = Array("A", "B", "C", "D", "E") For i = LBound(arrBlätter) To UBound(arrBlätter) On Error Resume Next Set ws = Worksheets(arrBlätter(i)) If ws Is Nothing Then Worksheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = arrBlätter(i) Else MsgBox "Blatt schon vorhanden" End If Next i Set ws = Nothing End Sub

Public Sub aaa() Dim arrBlätter As Variant Dim i As Long, ws As Worksheet Application.ScreenUpdating = False arrBlätter = Array("A", "B", "C", "D", "E") For i = LBound(arrBlätter) To UBound(arrBlätter) On Error Resume Next Set ws = Worksheets(arrBlätter(i)) If ws Is Nothing Then Worksheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = arrBlätter(i) Worksheets("PivotTable").PivotTables("Monatsauswertung").TableRange2.Copy _ Destination:=Worksheets(arrBlätter(i)).Range("B2") Else Worksheets("PivotTable").PivotTables("Monatsauswertung").TableRange2.Copy _ Destination:=Worksheets(arrBlätter(i)).Range("B2") End If Next i Set ws = Nothing End Sub

Public Sub aaa() Dim arrBlätter As Variant Dim i As Long, ws As Worksheet Application.ScreenUpdating = False arrBlätter = Array("A", "B", "C", "D", "E") For i = LBound(arrBlätter) To UBound(arrBlätter) On Error Resume Next Set ws = Worksheets(arrBlätter(i)) If ws Is Nothing Then Worksheets("PivotTable").Copy after:=Worksheets(Sheets.Count) ActiveSheet.Name = arrBlätter(i) End If Next i Set ws = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Tabellenblätter einfügen und umbenennen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread