Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon Petra65 vom 29.08.2021, 15:44 Options

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

Hallo,

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

Siehe: http://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

Antwort schreiben

Antwort 1 von Hajo_Zi vom 29.08.2021, 15:52 Options

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

Antwort 2 von nighty vom 29.08.2021, 16:00 Options

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

Antwort 3 von Petra65 vom 07.09.2021, 20:49 Options

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

Antwort 4 von Hajo_Zi vom 07.09.2021, 22:01 Options

Hallo Petra,

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

Gruß Hajo

Antwort 5 von nighty vom 08.09.2021, 09:37 Options

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

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Tipp einschicken

News einschicken