Code ändern: Nachfrage, wenn Tabelle existiert

Hallo Forumsbesucher,
ich hätte gerne, dass nachstehender Code so abgeändert wird, dass, falls eine Tabelle mit gleichem Namen in der Datei schon existiert, nachgefragt wird, ob die bestehende Tabelle gelöscht werden soll oder nicht:
Tabelle mit gleichem Namen bereits vorhanden! Soll diese gelöscht werden:
Ja/Nein
bei Ja: löschen und neu anlegen,
bei Nein: Code nicht ausführen
Vielen Dank für eure Hilfe
Gruß
Fritz


Sub Mitglieder_anlegen()
Worksheets("Tabelle2").Activate
ActiveSheet.Unprotect Password:="xxx"
Dim mysheet As Worksheet
Dim x As Boolean
cb = Cells(1, 4)
x = False
For Each mysheet In ActiveWorkbook.Worksheets
If mysheet.Name = cb Then
x = True
Else
End If
Next
If x = True Then
Else
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheets("Tabelle2").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = cb
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
Cells.Select
Range("B1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AD1:AI1").Select
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Mitglieder_anlegen() Dim wks As Worksheet Dim blnFnd As Boolean Dim strName As String Application.EnableEvents = False Application.ScreenUpdating = False Worksheets("Tabelle2").Unprotect Password:="xxx" strName = Worksheets("Tabelle2").Cells(1, 4) For Each wks In ThisWorkbook.Worksheets If wks.Name = strName Then blnFnd = True Exit For End If Next If blnFnd Then If MsgBox("Tabelle mit gleichem Namen bereits vorhanden!" & vbLf & _ "Soll diese gelöscht werden?", 4) = 6 Then Application.DisplayAlerts = False ThisWorkbook.Worksheets(strName).Delete Application.DisplayAlerts = True blnFnd = False End If End If If Not blnFnd Then Worksheets("Tabelle2").Copy After:=Sheets(Sheets.Count) Set wks = Sheets(Sheets.Count) wks.Name = strName wks.Cells.Copy wks.Range("A1").PasteSpecial xlPasteValues wks.Range("A1").Select Application.CutCopyMode = 0 End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub

Hallo Christoph,
dein Hinweis war entscheidend.
Ausgeruht, die Sache noch einmal angesehen, habe ich den Fehler schnell entdeckt.
Und es war natürlich mein Fehler.
Ich hatte tatsächlich zwischenzeitlich das Tabellenblatt 1 etwas verändert, so dass der jeweilige Dateiname (wird über eine Formel erzeugt) nun nicht mehr in Zelle D1, sondern in F1 steht. Man muss ja immer beachten, dass EXCEL den Code - im Gegensatz zu Formeleingaben - bei solchen Veränderungen natürlich nicht anpasst.
Wenn man zu lange am Computer sitzt, macht man Fehler, die man tags darauf selbst nicht mehr verstehen kann. Bitte um Entschuldigung!
Konnte den Code entsprechend selbst anpassen und nun läuft das Ganze wie gewünscht.
Nochmals vielen Dank und schöne Grüße
Fritz

Beliebteste Forumthreads (12 Monate)

Code ändern: Nachfrage, wenn Tabelle existiert

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