prüfen ob Worksheet vorhanden

Hallo zusammen,
mit einem Makro erzeuge ich monatlich/oder an beliebigem Datum das Blatt "wksMonat" mit dem Blattname Januar 2016, Februar 2016 usw.
Dieses jeweils neu erzeugte Blatt wird in die gleichzeitig geöffnete Datei "Monate" kopiert.

Sub codeschnipsel()
Workbooks.Open Filename:=ThisWorkbook.Path & "\Monate.xlsx"
With wksMonat
.Copy After:=Workbooks("Monate.xlsx").Sheets(2)
End With
ActiveWorkbook.Save
ActiveWindow.Close
wksMonat.Delete
ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
End Sub

Mit diesem .copy Befehl gelingt dies. ABER wenn das Monatsblatt bereits vorhanden ist wird als Januar 2016(2) oder Januar 2016(3) kopiert. Dies muss/möchte ich vermeiden. Deshalb sollte die Meldung kommen :"xxxx 2016" ist bereits vorhanden: Abbrechen? Überschreiben? oder Speichern mit Namenszusatz HEUTE?
Der erzeugte Blattname wäre dann z.B. Januar 2016_24.10 (weil heute am 24.10. erzeugt).
Diese Anpassung übersteigt meine Möglichkeiten weit!
Könnte mir jmd. diesen Code schreiben?
Sehr gerne erhalte ich dazu Nachrichten!
Gruß
Gerhard

Hi Gerhard,
hab mich noch mal hingesetzt. Bin zwar kein VBA-Profi aber hier mein Vorschlag. Ich hoffe, dass es in die Richtung geht. Wahrscheinlich gibts auch eine elegantere Variante. Verbesserungsvorschläge sind herzlich willkommen!

Function TabDa2(strBlatt As String) As Boolean
Dim wksBlatt As Worksheet
Dim wkbziel As Workbook
Set wkbziel = Workbooks("Monate.xlsm")
For Each wksBlatt In wkbziel.Worksheets
If wksBlatt.Name = strBlatt Then
TabDa2 = True
Exit For
End If
Next wksBlatt
End Function
Sub codeschnipsel()
Dim wkbziel As Workbook
Dim wkbQuelle As Workbook
Dim wksMonat As Worksheet
Dim strPfad As String
Dim strPfadZiel As String
Dim tabName As String
Dim byWert As Byte
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strPfad = "C:\" 'Pfad Quelldatei "Anwesenheit.xlsm" anpassen
strPfadZiel = "C:\" 'Pfad Zielmappe "Monate.xlsm" anpassen
Set wkbQuelle = Application.Workbooks.Open(strPfad)
Set wkbziel = Application.Workbooks.Open(strPfadZiel)
For Each wksMonat In wkbQuelle.Worksheets
If TabDa2(wksMonat.Name) = False Then
wksMonat.Copy After:=Workbooks("Monate.xlsm").Worksheets(Worksheets.Count)
wksMonat.Delete
Else
byWert = MsgBox(wksMonat.Name & " ist bereits vorhanden! Soll überschrieben werden?" _
, 4, "Abfrage bei vorhanden")
On Error GoTo fehler: 'Wenn wkbQuelle nach Schleife leer, Default Tabelle  _
hinzufügen
If byWert = 6 Then
Workbooks("Monate.xlsm").Worksheets(wksMonat.Name).Delete
wksMonat.Copy After:=Workbooks("Monate.xlsm").Worksheets(Worksheets.Count)
wksMonat.Delete
ElseIf byWert = 7 Then
byWert = MsgBox("Soll für das vorhandene Blatt " & wksMonat.Name & _
" ein neuer Tabellenname angelegt werden?", 4, "Vorhandener  _
Tabellenname")
If byWert = 6 Then
wiederholen:
tabName = InputBox(prompt:="Bitte Namen eingeben")
If Len(tabName) > 0 Then
wksMonat.Name = tabName
wksMonat.Copy After:=Workbooks("Monate.xlsm").Worksheets(Worksheets. _
Count)
wksMonat.Delete
GoTo next_i 'Nächste wksMappe, wenn Name eingegeben wurde
ElseIf byWert = 7 Then GoTo next_i
Else: GoTo wiederholen 'Wenn kein Name eingegeben wurde
End If
End If
End If
End If
next_i:
Next wksMonat
fehler:
While wkbQuelle.Worksheets.Count > 1 'Falls nicht alle Tabellen in wkbQuelle gelöscht  _
wurden
Worksheets(1).Delete
Wend
Workbooks("Anwesenheit.xlsm").Close savechanges:=True
Workbooks("Monate.xlsm").Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

VG Anton

Forumthread: prüfen ob Worksheet vorhanden

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Prüfen, ob ein Worksheet vorhanden ist

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)