Blatt nach Comboboxauswahl aktivieren

Hallo Excelprofis,
Mit nachfolgendem Code werden 2 Blätter (TestA und TestB) aktiviert und das jeweils aktive Blatt kopiert und nach Comboboxinhalt benannt. Vielen Dank an Rudi und Robert für die Hilfe.
Jetzt gibt es aber noch 2 Blätter (in der Bespielmappe nur eins) da muss je nach Comboboxauswahl das Vorjahresblatt kopiert werden. Am besten auch über den Schritt Aktivierung, da kann ich den weiteren Code verwenden.
Also, wenn in Combobox1 das Jahr 2019 ausgewählt ist, möchte ich das Blatt "TestC 2018" aktivieren, wenn in Combobox1 das Jahr 2018 ausgewählt wird, soll das Blatt "TestC 2017" aktviert werden.
https://www.herber.de/bbs/user/122478.xlsm
Kann mir bitte Jemand helfen.
Danke fürs lesen und die Mühe.
mfg, Andreas
Option Explicit

Private Sub ComboBox1_Change()
ComboBox1.Value = Format(ComboBox1.Value, ("dd.mm.yyyy"))
End Sub

Private Sub CommandButton1_Click()
Dim wks As Worksheet
Dim BlattName As String
Dim MyBool As Boolean
Dim NewTabelName As String
Sheets("TestAVorlage").Visible = True
Sheets("TestAVorlage").Activate
If ComboBox1.ListIndex > -1 Then
'Neuen TabellenName aus Combobox holen und merken
NewTabelName = ComboBox1.Value
BlattName = ComboBox1.Value
'Prüfe ob Blattname schon vorhanden ist
For Each wks In ThisWorkbook.Worksheets
If wks.Name = BlattName Then
MyBool = True
Exit For
End If
Next
If Not MyBool Then
'Tabelle kopieren und hinter der letzten Tabelle einfügen
ActiveSheet.Copy After:=Sheets(Sheets.Count)
'der neuen Tabelle den Name geben
Sheets(Sheets.Count).Name = "TestA " & Year(CDate(NewTabelName))
With ActiveSheet.Range("A3")
.Value = CDate(ComboBox1.Value)
'.NumberFormat = "YYYY"
End With
Else
MsgBox "Das Blatt [" & BlattName & "] ist schon vorhanden", vbInformation
End If
End If
Sheets("TestBVorlage").Visible = True
Sheets("TestBVorlage").Activate
If ComboBox1.ListIndex > -1 Then
'Neuen TabellenName aus Combobox holen und merken
NewTabelName = ComboBox1.Value
BlattName = ComboBox1.Value
'Prüfe ob Blattname schon vorhanden ist
For Each wks In ThisWorkbook.Worksheets
If wks.Name = BlattName Then
MyBool = True
Exit For
End If
Next
If Not MyBool Then
'Tabelle kopieren und hinter der letzten Tabelle einfügen
ActiveSheet.Copy After:=Sheets(Sheets.Count)
'der neuen Tabelle den Name geben
Sheets(Sheets.Count).Name = "TestB " & Year(CDate(NewTabelName))
With ActiveSheet.Range("A3")
.Value = CDate(ComboBox1.Value)
'.NumberFormat = "YYYY"
End With
Else
MsgBox "Das Blatt [" & BlattName & "] ist schon vorhanden", vbInformation
End If
End If
End Sub

Private Sub UserForm_Initialize()
With Me.ComboBox1
.RowSource = "Satz"
.ListIndex = -1
End With
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub ComboBox1_Change() ComboBox1.Value = Format(ComboBox1.Value, ("dd.mm.yyyy")) End Sub Private Sub CommandButton1_Click() Dim NewDate As Date Dim NewYear As Integer If ComboBox1.ListIndex > -1 Then 'TestA xxxx anlegen NewDate = CDate(ComboBox1.Value) NewYear = Year(NewDate) If fncCopyVorlage(wksVorlage:=Sheets("TestAVorlage"), _ Blattname:="TestA " & NewYear, Datum:=NewDate) = True Then 'Blatt neu angelegt Else End If 'TestB xxxx anlegen If fncCopyVorlage(wksVorlage:=Sheets("TestBVorlage"), _ Blattname:="TestB " & NewYear, Datum:=NewDate) = True Then 'Blatt neu angelegt Else 'Blatt schon vorhanden End If '"TestC JAHR" suchen/kopieren und umbenennen If fncCopyTestC_VJ(Blatt:="TestC ", Datum:=NewDate) = True Then 'Blatt neu angelegt Else 'Blatt schon vorhanden End If End If End Sub Function fncCopyTestC_VJ(Blatt As String, Datum As Date) Dim MyBool Dim wks As Worksheet Dim Blattname, JJ As Integer JJ = Year(Datum) MyBool = False 'Prüfen ob das neue Blatt für ausgewähltes Jahr schon vorhanden ist Blattname = Blatt & JJ For Each wks In ThisWorkbook.Worksheets If wks.Name = Blattname Then MsgBox "Das Blatt [" & Blattname & "] ist schon vorhanden", _ vbInformation MyBool = True Exit For End If Next If MyBool = False Then 'Prüfe ob Blatt von Vorjahr vorhanden Blattname = Blatt & (JJ - 1) For Each wks In ThisWorkbook.Worksheets If wks.Name = Blattname Then MyBool = True Exit For End If Next If MyBool Then Sheets(Blattname).Visible = True Sheets(Blattname).Activate 'Tabelle kopieren und hinter der letzten Tabelle einfügen ActiveSheet.Copy After:=Sheets(Sheets.Count) 'der neuen Tabelle den Name geben Sheets(Sheets.Count).Name = Blatt & JJ With ActiveSheet.Range("A3") .Value = Datum '.NumberFormat = "YYYY" End With fncCopyTestC_VJ = True Else fncCopyTestC_VJ = False MsgBox "Das Blatt [" & Blattname & "] ist nicht vorhanden", _ vbInformation End If End If End Function Private Function fncCopyVorlage(wksVorlage As Worksheet, Blattname As String, _ Datum As Date) As Boolean Dim MyBool As Boolean Dim wks As Worksheet wksVorlage.Visible = True wksVorlage.Activate MyBool = False 'Prüfe ob Blattname schon vorhanden ist For Each wks In ThisWorkbook.Worksheets If wks.Name = Blattname Then MyBool = True Exit For End If Next If Not MyBool Then 'Tabelle kopieren und hinter der letzten Tabelle einfügen ActiveSheet.Copy After:=Sheets(Sheets.Count) 'der neuen Tabelle den Name geben Sheets(Sheets.Count).Name = Blattname With ActiveSheet.Range("A3") .Value = Datum '.NumberFormat = "YYYY" End With fncCopyVorlage = True Else MsgBox "Das Blatt [" & Blattname & "] ist schon vorhanden", vbInformation fncCopyVorlage = False End If End Function Private Sub UserForm_Initialize() With Me.ComboBox1 .RowSource = "Satz" .ListIndex = -1 End With End Sub

Beliebteste Forumthreads (12 Monate)

Blatt nach Comboboxauswahl aktivieren

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Blatt nach Comboboxauswahl aktivieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread