Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1596to1600
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Sheet überprüfen

Sheet überprüfen
24.12.2017 12:54:25
Sigrid
Hallo nzusammen,
erst mal allen ein schönes Weihnachtsfest.
Ich muss leider noch etwas für nächste Woche vorbereiten.
Ich habe vor einer Zeit nachgefragt wegen Sheet überprüfen
ob vorhanden ist.
Jetzt habe ich das Makro so, bin ja lernfähig, wie ich es brauche.
Funktioniert alles super, mir ist jedoch aufgefallen, wenn ich nach dem
erstellen des neuen Namens wieder prüfen will ob auch dieser vorhanden ist,
also irgendwie eine schleife, nachdem ich den neuen Namen eingegeben habe.
Anbei das Makro:
Public Sub smr_Neue_Tabelle_erstellen()
Dim ws As Worksheet
Dim vorhanden As Boolean
Dim i As Integer
Dim neuname
Sheets("Muster").Activate
ActiveSheet.Range("B2").Select
ActiveSheet.Range("B2") = "Muster"
Sheets("Muster").Select
ActiveSheet.Copy After:=Sheets(Worksheets.Count)
'-----------------------------------------------------
Dim strBlattName As String
strBlattName = ActiveSheet.Range("B2").Value
On Error Resume Next
Dim Eingabe$ 'String
Eingabe = InputBox("Bitte ww:", "Zelleneingabe:", Range("B2").Text)
If StrPtr(Eingabe) = 0 Then Exit Sub
Dim myWsh As Worksheet
On Error Resume Next
' Arbeitsblattname anpassen
Set myWsh = Worksheets(Eingabe)
If Err.Number 0 Then
' MsgBox "fehlt"
ActiveSheet.Range("B2").Value = Eingabe
ActiveSheet.Name = Eingabe
Else
MsgBox "vorhanden neuen namen erstellen"
Eingabe = InputBox("Bitte Tabellenname eingeben:", "Sheet-Namen festlegen:", Range("B2").Text)
If StrPtr(Eingabe) = 0 Then Exit Sub
ActiveSheet.Range("B2").Value = Eingabe
ActiveSheet.Name = Eingabe
End If
On Error GoTo 0
Exit Sub
würde mich freuen etwas zu hören, zu lesen...
gruß
sigrid

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sheet überprüfen
24.12.2017 12:57:51
Hajo_Zi
Hallo Sigrid,
ich würde es so machen.
Option Explicit
Sub TabAuswahl()
Dim BoVorhanden As Boolean
Dim WsTabelle As Worksheet
For Each WsTabelle In Worksheets
If WsTabelle.Name = "Tabelle1" Then
BoVorhanden = True
Exit For
End If
Next WsTabelle
If BoVorhanden Then
'vorhanden
Else
'nicht vorhanden
End If
End Sub


Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Also ich schreibe keine Beiträge mit dem Betreff "Gerne u. Danke für die Rückmeldung. o.w.T."
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben,
mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
Beiträge von Werner, Luc, robert und folgende lese ich nicht.
Anzeige
Ja aber wenn...
24.12.2017 13:09:10
Sigrid
Hallo Hajo,
danke für das schnelle Antworten.
Habe so reingesetzt, reagiert aber was muss ich noch einfügen,
damit ich einen neuen Namen eingeben kann und dieser ebenfalls überprüft wird.
gruß
sigrid
Dim ws As Worksheet
Dim vorhanden As Boolean
Dim i As Integer
Dim neuname
Sheets("Muster").Activate
ActiveSheet.Range("B2").Select
ActiveSheet.Range("B2") = "Muster"
Sheets("Muster").Select
ActiveSheet.Copy After:=Sheets(Worksheets.Count)
'-----------------------------------------------------
Dim strBlattName As String
strBlattName = ActiveSheet.Range("B2").Value '"Muster"
On Error Resume Next
'Worksheets(strBlattName).Activate
Dim Eingabe$ 'String
Eingabe = InputBox("Bitte ww:", "Zelleneingabe:", Range("B2").Text)
If StrPtr(Eingabe) = 0 Then Exit Sub
Dim BoVorhanden As Boolean
Dim WsTabelle As Worksheet
For Each WsTabelle In Worksheets
If WsTabelle.Name = Eingabe Then
BoVorhanden = True
Exit For
End If
Next WsTabelle
If BoVorhanden Then
'vorhanden
MsgBox "vorhanden neuen namen erstellen"
Else
MsgBox "fehlt"
'nicht vorhanden
End If
Exit Sub
Anzeige
AW: Ja aber wenn...
24.12.2017 18:37:14
Hajo_Zi
Sheets.Add.Name = "123"
Gruß Hajo
AW: Ja aber wenn...
25.12.2017 09:28:23
Werner
Hallo Sigrid,
teste mal:
Public Sub smr_Neue_Tabelle_erstellen()
Dim strBlattname As String, strName As String, varNeu As Variant
Dim wsTabelle As Worksheet, boVorhanden As Boolean
strBlattname = Worksheets("Muster").Range("B2")
For Each wsTabelle In ThisWorkbook.Worksheets
If wsTabelle.Name = strBlattname Then
boVorhanden = True
Exit For
End If
Next wsTabelle
If Not boVorhanden Then
Worksheets("Muster").Copy after:=Sheets(Worksheets.Count)
ActiveSheet.Name = strBlattname
Exit Sub
End If
boVorhanden = False
Do Until boVorhanden = True
If varNeu = vbNullString Then
strName = strBlattname
Else
strName = varNeu
End If
varNeu = InputBox("Neuer Blattname bitte:", "Das Blatt " & strName & " schon vorhanden")
If StrPtr(varNeu) = 0 Then Exit Sub
For Each wsTabelle In ThisWorkbook.Worksheets
If wsTabelle.Name = varNeu Then
boVorhanden = False
Exit For
Else
boVorhanden = True
End If
Next wsTabelle
If boVorhanden Then
If Not varNeu = vbNullString Then
Worksheets("Muster").Copy after:=Sheets(Worksheets.Count)
ActiveSheet.Name = varNeu
Exit Do
End If
End If
Loop
End Sub
Gruß Werner
Anzeige
AW: Ja aber wenn...
25.12.2017 09:48:45
Gerd
Hallo Sigrid!
Sub test()
Dim Eingabe As String, BoVorhanden As Boolean, WsTabelle As Worksheet
Do
BoVorhanden = False
Eingabe = InputBox("Bitte ww:", "Blattname:", "Muster")
If StrPtr(Eingabe) = 0 Then Exit Sub
For Each WsTabelle In Worksheets
If UCase(WsTabelle.Name) = UCase(Eingabe) Then
BoVorhanden = True
Exit For
End If
Next WsTabelle
If BoVorhanden Then
'vorhanden
MsgBox "Der Blattname ist schon vorhanden! Neuen namen erstellen!"
Else
'nicht vorhanden
MsgBox "fehlt"
Application.DisplayAlerts = False
Sheets("Muster").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Eingabe
End If
Loop While BoVorhanden = True
End Sub

Gruß Gerd
Anzeige
AW: Ja aber wenn...
25.12.2017 09:49:01
Gerd
Hallo Sigrid!
Sub test()
Dim Eingabe As String, BoVorhanden As Boolean, WsTabelle As Worksheet
Do
BoVorhanden = False
Eingabe = InputBox("Bitte ww:", "Blattname:", "Muster")
If StrPtr(Eingabe) = 0 Then Exit Sub
For Each WsTabelle In Worksheets
If UCase(WsTabelle.Name) = UCase(Eingabe) Then
BoVorhanden = True
Exit For
End If
Next WsTabelle
If BoVorhanden Then
'vorhanden
MsgBox "Der Blattname ist schon vorhanden! Neuen namen erstellen!"
Else
'nicht vorhanden
MsgBox "fehlt"
Application.DisplayAlerts = False
Sheets("Muster").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Eingabe
End If
Loop While BoVorhanden = True
End Sub

Gruß Gerd
Anzeige
Super !!! frohes Weihnachtsfest an ALLE -)
25.12.2017 10:51:07
Sigrid
Guten Morgen,
Hajo, Werner und Gerd,
Super habe Makro und Werners Makro getestet, einwandfrei !
Schöne Feiertage noch !!!
DANKE !!!
gruß
sigrid
Gerne u. Danke für die Rückmeldung. o.w.T.
25.12.2017 10:53:05
Werner

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige