bestehendes Makro erweitern ... Abfrage ob Tabelle bereits vorhanden ist

Question

Hallo,

dank kompetenter Hilfe aus dem Supportnet arbeite ich mit unten stehendem Makro, dieses legt Tabellen neu an.

Siehe: www.supportnet.de/t/2258587

Es ist allerdings so, dass (falls irrtümlich eine Tabelle das zweite Mal angelegt wird) die erste Tabelle überschrieben wird.
Ich benötige also eine Abfrage, ob die Tabelle bereits vorhanden ist.

If Tabelle vorhanden Then
MsgBox "Tabelle existiert bereits !"
Else

Ich stehe mal wieder total auf dem "Schlauch", weiss weder WIE noch WO ich das einbinden müsste - nach With objWorkbookOpen ???

Ich hoffe nochmals auf Hilfe, vielen Dank ...

Gruss
Petra



Option Explicit

Sub UserDatei_oeffnen_fuellen_und_speichern()
Dim objWorkbookOpen As Object
On Error GoTo ERRORHANDLER
Application.DisplayAlerts = False
If Columns(1).EntireColumn.Hidden = False Then
Set objWorkbookOpen = Workbooks.Open(ThisWorkbook.Path & "\User1\User1.xls")
With objWorkbookOpen
.Sheets("Tabelle1").Range("I3") = ThisWorkbook.Sheets("Lieferanten").Range("M5")
.SaveAs ThisWorkbook.Path & "\User1\" & .Sheets("Tabelle1").Range("I3") & ".xls"
End With
ElseIf Columns(1).EntireColumn.Hidden = True Then
Set objWorkbookOpen = Workbooks.Open(ThisWorkbook.Path & "\User2\User2.xls")
With objWorkbookOpen
.Sheets("Tabelle1").Range("I3") = ThisWorkbook.Sheets("Lieferanten").Range("M5")
.SaveAs ThisWorkbook.Path & "\User2\" & .Sheets("Tabelle1").Range("I3") & ".xls"
End With
End If
ERRORHANDLER:
Application.DisplayAlerts = True
Set objWorkbookOpen = Nothing
End Sub

Answer 1

Hallo Petra,

feststellen, ob Worksheet vorhanden ist
hier ein Beispiel, welches Du relativ einfach entsprechend abändern kannst:
Sub TabAuswahl()
Dim Sh As Worksheet
Dim sName$
sName = InputBox("Bitte Tabellenname eingeben!")
For Each Sh In Worksheets
If InStr(Sh.Name, sName) > 0 Then
Sh.Select
Exit Sub
End If
Next Sh
Beep
MsgBox "Kein Blatt gefunden!"
End Sub

Gruß hajo

Answer 2

hi all ^^

ein beispiel :-))

gruss nighty

Sub DeinMakro()
If SheetExists("" & DeineVariable) = True Then
Rem ja
Else
Rem nein
End If
End Sub

Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Worksheets(strName) Is Nothing
End Function

Answer 3

Hallo,

ich muss diese Frage nochmals aktivieren, da ich den Lösungsweg einfach nicht finde ;-)))

Entweder ich erhalte Fehlermeldungen, oder die Tabellen werden trotzdem erstellt.
Ich mache bestimmt wieder irgendwo irgendwas falsch ...

Ich habe z. B. folgendes versucht:

Dim sName$
...
sName = ThisWorkbook.Sheets("Lieferanten").Range("L5" & ".xls")
If sName > 0 Then
MsgBox ("Tabelle bereits vorhanden !")
Exit Sub
End If

ODER folgenden

Dim Sh As Worksheet
Dim sName$
...
Sh = ThisWorkbook.Sheets("Lieferanten").Range("L5" & ".xls")
If InStr(Sh.Name, sName) > 0 Then
Sh.Select
Exit Sub
End If

Ich hoffe mal wieder auf Hilfe ....

Viele Grüße - Petra

Answer 4

Hallo Petra,

schaue Dir meinen Code an, da wird eine Schleife über alle Tabellen gemacht.

Gruß Hajo

Answer 5

hi petra ^^

oder so :-)

gruss nighty

Sub DeinMakro()
If SheetExists("" & ThisWorkbook.Sheets("Lieferanten").Range("L5" & ".xls")) = True Then
Rem HUHU bin vorhanden Tataaa
Else
Rem schniff ,keiner da
End If
End Sub

Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Worksheets(strName) Is Nothing
End Function