prüfen ob Worksheet vorhanden

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function TabDa(strBlatt As String) As Boolean Dim wksBlatt As Worksheet For Each wksBlatt In ThisWorkbook.Worksheets If wksBlatt.Name = strBlatt Then TabDa = True Exit For End If Next wksBlatt End Function

Hallo Anton,
Danke für deine Antwort.
Leider hatte ich in der Anfrage dies nicht deutlich genug beschrieben:
In der Ursprungsdatei "Anwesenheit.xlsm" werden Monatsblätter (= wksMonat) z. B. "Januar 2016" als Kopie eines Tabellenbereichs einmalig erzeugt. Das erzeugte Blatt ist vorher nicht vorhanden und wird nach dem Kopiervorgang wieder gelöscht. Deshalb kann/muss in der Ursprungsdatei auf Duplikat nicht geprüft werden.
Das aktuelle, neu erzeugte Monatsblatt z. B. Worksheet("Januar 2016") wird in die Ziel-Datei "Monate.xlsm" kopiert und anschließend in der Ursprungsdatei "Belegungsplanung" gelöscht. In der Zieldatei könnte das Monatsblatt Worksheet("Januar 2016") aber bereits vorhanden sein. Mit meinem bisherigen Code wird ungeprüft kopiert und evtl. das Blatt "Januar 2016(2) oder ...(3) zugefügt. Hier in der Ziel-Datei "Monate.xlsm" soll vor dem Einfügen des Blattes auf Überschreiben? oder Anderer Blattname? geprüft werden. Die Überprüfung muss im Makro in der Ursprungsdatei erfolgen.
Mit (..With wksMonat .Copy After:=Workbooks("Monate.xlsx").Sheets(2)...) geschieht KEINE Prüfung.
Ich hoffe, dass es dafür eine Lösung gibt.
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

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

prüfen ob Worksheet vorhanden

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread