Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zelleninhalte>Anlegen gleichlautender Tab.blätter

Zelleninhalte>Anlegen gleichlautender Tab.blätter
JAT
Guten Tag liebe Excel-Freunde,
Folgendendes möchte ich (möglichst automatisch) realisieren:
In Spalte A stehen lfd. Nummern von 1-100 (oder was anderes), welche ich markiert habe.
Jetzt suche ich eine Funktion, wo Excel in der Datei für jede der markierten Zellen ein gleichlautendes Tabellenblatt anlegt.
Obendrein soll die Zahl dann noch direkt via Hyperlink mit dem Tabellenblatt verbunden sein (per Klick auf Zahl "springt" man direkt zum jeweiligen Tabelleblatt).
Hätte jemand eine Idee, ob Excel eine solche Funktion abietet?
PS: Einzeln Tabellen erstellen ist klar, einzeln die Hyperlinks über Einfügen-Hyperlink-Aktuelles Dokument ist ebenfalls klar. Nur weil es eben sehr sehr viele Zahlen sind, wäre es schön, wenn das irgendwie automatisiert werden könnte....:-(
Herzliche Grüße
JAT

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Zelleninhalte>Anlegen gleichlautender Tab.blätter
11.07.2011 20:14:04
fcs
JAT,
hier ein Makro zum Anlegen der Blätter. Die Namen im Zellbereich werden werden auch geprüft, ob sie alls Blattnamen zulässig sind.
Gruß
Franz
Sub aaTabellen_anlegen()
Dim oRange As Range, Zelle As Range, wksNeu As Worksheet, oWB As Workbook, vType
Dim icount As Integer, sName As String
On Error GoTo Fehler
Set oWB = ActiveWorkbook
Set oRange = Selection
vType = xlWorksheet 'Standardworksheet anfügen
'vType = "C:\Users\MyName\Vorlagen\MusterVorlage.xlst" 'Vordefinierte Vorlage einfügen
Application.ScreenUpdating = False
For Each Zelle In oRange
icount = icount + 1
If Zelle  "" Then
sName = Zelle.Text
sName = CheckSheet(sName)
If sName  "" Then
Application.StatusBar = "Blatt " & Zelle.Text & " (" & icount & " von " _
& oRange.Cells.Count & ") wird angelegt"
Set wksNeu = oWB.Worksheets.Add(After:=oWB.Sheets(oWB.Sheets.Count), Type:=vType)
wksNeu.Name = sName
Zelle.Parent.Hyperlinks.Add Anchor:=Zelle, Address:="", SubAddress:="'" & sName & "'!A1",  _
_
ScreenTip:="Tabellenblatt: " & wksNeu.Name
End If
Resume01:
End If
Next Zelle
oRange.Parent.Activate
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 1004
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
Resume Resume01
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.StatusBar = False
End Sub
Private Function CheckSheet(ByVal sBlattName As String, Optional oWB As Workbook) As String
Dim arrZeichen, oSheet As Object, arrUnzul, iJ As Integer
'Prüfen, ob Blatt schon vorhanden
If oWB Is Nothing Then Set oWB = ActiveWorkbook
CheckName:
For Each oSheet In oWB.Sheets
If UCase(oSheet.Name) = UCase(sBlattName) Then
MsgBox "Ein Blatt mit dem Namen """ & sBlattName & """ existiert bereits. Name wird ü _
bersprungen"
CheckSheet = ""
GoTo Beenden:
End If
Next
'Prüfen auf ungültige Zeichen ? [ ] / \ * :
arrUnzul = Array("?", "[", "]", "/", "\", "*", ":")
For iJ = LBound(arrUnzul) To UBound(arrUnzul)
If InStr(1, sBlattName, arrUnzul(iJ)) > 0 Then
sBlattName = InputBox(Prompt:="Der Blattname """ & sBlattName _
& """ enthält eines der unzulässigen Zeichen ? [ ] / \ * :" _
& vbLf & "Bitte Name anpassen", Title:="Prüfung Blattname - " & sBlattName, _
Default:=sBlattName)
If sBlattName = "" Then
CheckSheet = ""
GoTo Beenden
Else
GoTo CheckName
End If
End If
Next
'Prüfen maximale Länge 31 Zeichen
If Len(sBlattName) > 31 Then
sBlattName = InputBox(Prompt:="Der Blattname """ & sBlattName & """ hat mehr als 31  _
Zeichen" _
& vbLf & "Bitte Name anpassen", Title:="Prüfung Blattname - " & sBlattName, _
Default:=Left(sBlattName, 31))
If sBlattName = "" Then
CheckSheet = ""
GoTo Beenden
Else
GoTo CheckName
End If
End If
CheckSheet = sBlattName
Beenden:
Set oSheet = Nothing
End Function

Anzeige
AW: Zelleninhalte>Anlegen gleichlautender Tab.blätter
12.07.2011 08:45:16
JAT
Hallo Franz,
uiuiui...,das sieht kompliziert aus...
Recht herzlichen Dank und meinen Respekt für die Arbeit, welche Du Dir gemacht hast. Ich versuche das mal irgendwie einzubinden in Excel2007.
Beste Grüße
JAT
AW: Zelleninhalte>Anlegen gleichlautender Tab.blätter
12.07.2011 22:43:39
fcs
Hallo JAT,
wenn du auf die Prüfung des Tabllenblattnamens verzichten kannst/willst, dann kannst du das Makro wie folgt einkürzen. Nach Fehlern wird die Ausführung "einfach" in der folgenden Zeile fortgesetz.
Gruß
Franz
Sub aaTabellen_anlegen()
Dim oRange As Range, Zelle As Range, wksNeu As Worksheet, oWB As Workbook
On Error Resume Next
Set oWB = ActiveWorkbook
Set oRange = Selection
Application.ScreenUpdating = False
For Each Zelle In oRange
If Trim(Zelle)  "" Then
Set wksNeu = oWB.Worksheets.Add(After:=oWB.Sheets(oWB.Sheets.Count), Type:=xlWorksheet)
wksNeu.Name = Zelle.Text
Zelle.Parent.Hyperlinks.Add Anchor:=Zelle, Address:="", _
SubAddress:="'" & Zelle.Text & "'!A1", _
ScreenTip:="Tabellenblatt: " & wksNeu.Name
End If
Next Zelle
oRange.Parent.Activate
End Sub

Anzeige

324 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige