Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1084to1088
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

Arbeitsblätternamen/Reiternamen auslesen

Arbeitsblätternamen/Reiternamen auslesen
Overmind
Hallo,
kennt jemand eine einfache Lösung, mit der Mann sämtliche Reitername in einem Arbeitsblatt auslesen lassen kann und dann in einem anderen Arbeitsblatt untereinander schreiben kann.
Viele Grüße und schon einmal vielen Dank.
Jan
AW: Arbeitsblätternamen/Reiternamen auslesen
29.06.2009 08:26:28
Backowe
Hi Jan,
VBA-Code:
Sub TabNamenAuflisten()
Dim ws As Worksheet
Dim i As Integer
i = 1
For Each ws In Worksheets
  Cells(i, "A") = ws.Name
  i = i + 1
Next
End Sub
Gruß Jürgen
AW: Arbeitsblätternamen/Reiternamen auslesen
Overmind

Super, danke!
Weißt du auch wie es anders herum geht?
AW: Arbeitsblätternamen/Reiternamen auslesen
Backowe

Hi Jan,
was meinst Du damit, absteigende Sortierung?
Gruß Jürgen
AW: Arbeitsblätternamen/Reiternamen auslesen
Overmind

Ich meinte:
Ich schreibe ein Tabelle mit Namen und Excel erstellt mir die Reiter mit den entsprechenden Namen.
AW: Arbeitsblätternamen/Reiternamen auslesen
Backowe

Hi Jan,
VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  'Code in das entsprechende Tabellenblatt
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Gruß Jürgen
AW: Arbeitsblätternamen/Reiternamen auslesen
Overmind

Wie bekomme ich das zum Laufen? Will irgendwie ein Makro von mir haben?
Der Code kommt in die Tabelle!
Backowe

Hi Jan,
rechte Maustaste auf Tabellenreiter, "Code anzeigen " auswählen und den Code in das rechte Fenster kopieren und VBA-Editor schliessen, dann sollte es funktionieren.
Gruß Jürgen
AW: Der Code kommt in die Tabelle!
Overmind

Hi Jürgen,
super, vielen Dank!
Nochmals zu deinen Ersten Code: Funktioniert super!
******************************************

Sub TabNamenAuflisten()
Dim ws As Worksheet
Dim i As Integer
i = 1
For Each ws In Worksheets
Cells(i, "A") = ws.Name
i = i + 1
Next
End Sub


*********
Gibt es eine mgl. das die ich die Zeilen wie eine Inhaltsverzeichnis nutzen kann? D.h. das sie als Link gleich auf die Reiter funktionieren?
Noch eine anderen Frage, unabhängig von der obrigen. Ich muss mich gerade in viele Dateien einarbeiten, die unendlich miteinander verknüpft sind. Gibt es ein Tool, dass wie ein Chart zeigt, wie die Datei mit sämtlichen anderen Dateien verknüft ist. Sprich: aus der Datei die Info, aus der anderen die......
Gibt es so etwas?
Vielen Dank nochmals ,
Jan

AW: Der Code kommt in die Tabelle!
Backowe

Hi Jan,
zu Deiner 1. Frage:
VBA-Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Der Code kommt wieder in das Tabellenblatt
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
  If Target <> "" Then Sheets("" & Target.Value & "").Activate
End If
End Sub
Zu Deiner 2. Frage, schaue Dir mal folgende Seite an: http://www.xlam.ch/vbacode/vbacode5.htm#Externe%20Verkn%C3%BCpfungen%20in%20einer%20Arbeitsmappe%20auflisten
Gruß Jürgen
AW: Arbeitsblätternamen/Reiternamen auslesen
Overmind

Hallo Juergen,
das Tool "TabNamenAuflisten()" funktioniert super. Kann man das erweitern, dass er gleich eine Hyperlinkverknüpfung auf den Reiter z.B. Zelle A1 macht?.
Dann könnte man diese Auflistung wie ein Inhaltsverzeichnis nutzen.
Viele Grüsse und nochmals vielen Dank an alle.
Jan
Das hatte Dir gestern zwar schon in ...
Backowe

Hallo Jan,
... Teilstücken geschrieben, so jetzt das Ganze noch einmal zusammengefasst!
VBA-Code:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'Der Code kommt wieder in das Tabellenblatt
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" Then Sheets("" & Target.Value & "").Activate
  End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      Application.GoTo Reference:=Sheets("Tabelle1").Range("A1"), Scroll:=True
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Gruß Jürgen
AW: Das hatte Dir gestern zwar schon in ...
Overmind

Ja, das funktioniert super. Was passiert aber, wenn jemand einen Namen eine Reiters ändert. Das machen hier bei mir bei der Arbeit anscheinend Leute zum Hobby ;-).
Dann drohe den Leuten mit der Prügelstrafe! :)
Backowe

Hi Jan,
wird ein Tabellenname geändert, wird er beim Deaktivieren der Tabelle wieder auf den ursprünglichen Namen zurückgesetzt. Aber eine Manipulation ist natürlich möglich! ;o)
VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  'Code in die Tabelle!
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      MakroEinfuegen (Target.Value)
      Application.Goto Reference:=Sheets(1).Range("A1"), Scroll:=True
      Columns(1).Clear
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
      On Error Resume Next
      For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), Address:="#" & Range("A" & i).Value & "!A1", _
          TextToDisplay:=Range("A" & i).Value
      Next
      On Error GoTo 0
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Sub MakroEinfuegen(Tabellenname As String)
  'Code in ein Modul!
  Dim i As Integer
  With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    i = .CreateEventProc("Deactivate", "Worksheet")
    .InsertLines i + 1, "Me.Name = """ & Tabellenname & """"
  End With
End Sub
Gruß Jürgen
VBA Lösung
Tino

Hallo,
hier mal eine VBA Lösung.
kommt als Code in ein Modul
Option Explicit 
 
Function TabellenName(iIndex As Integer) As String 
 TabellenName = Sheets(iIndex).Name 
End Function 


In der Tabelle kannst Du dies nun wie eine Formel verwenden.
Tabelle1

 A
1Tabelle1
2Tabelle2

Formeln der Tabelle
ZelleFormel
A1=TabellenName(ZEILE($A1))
A2=TabellenName(ZEILE($A2))

Gruß Tino
Anzeige
AW: Arbeitsblätternamen/Reiternamen auslesen
29.06.2009 08:32:02
Overmind
Super, danke!
Weißt du auch wie es anders herum geht?
AW: Arbeitsblätternamen/Reiternamen auslesen
29.06.2009 08:45:53
Backowe
Hi Jan,
was meinst Du damit, absteigende Sortierung?
Gruß Jürgen
AW: Arbeitsblätternamen/Reiternamen auslesen
29.06.2009 08:55:06
Overmind
Ich meinte:
Ich schreibe ein Tabelle mit Namen und Excel erstellt mir die Reiter mit den entsprechenden Namen.
AW: Arbeitsblätternamen/Reiternamen auslesen
29.06.2009 09:07:13
Backowe
Hi Jan,
VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  'Code in das entsprechende Tabellenblatt
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Gruß Jürgen
AW: Arbeitsblätternamen/Reiternamen auslesen
Overmind

Wie bekomme ich das zum Laufen? Will irgendwie ein Makro von mir haben?
Der Code kommt in die Tabelle!
Backowe

Hi Jan,
rechte Maustaste auf Tabellenreiter, "Code anzeigen " auswählen und den Code in das rechte Fenster kopieren und VBA-Editor schliessen, dann sollte es funktionieren.
Gruß Jürgen
AW: Der Code kommt in die Tabelle!
Overmind

Hi Jürgen,
super, vielen Dank!
Nochmals zu deinen Ersten Code: Funktioniert super!
******************************************

Sub TabNamenAuflisten()
Dim ws As Worksheet
Dim i As Integer
i = 1
For Each ws In Worksheets
Cells(i, "A") = ws.Name
i = i + 1
Next
End Sub


*********
Gibt es eine mgl. das die ich die Zeilen wie eine Inhaltsverzeichnis nutzen kann? D.h. das sie als Link gleich auf die Reiter funktionieren?
Noch eine anderen Frage, unabhängig von der obrigen. Ich muss mich gerade in viele Dateien einarbeiten, die unendlich miteinander verknüpft sind. Gibt es ein Tool, dass wie ein Chart zeigt, wie die Datei mit sämtlichen anderen Dateien verknüft ist. Sprich: aus der Datei die Info, aus der anderen die......
Gibt es so etwas?
Vielen Dank nochmals ,
Jan

AW: Der Code kommt in die Tabelle!
Backowe

Hi Jan,
zu Deiner 1. Frage:
VBA-Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Der Code kommt wieder in das Tabellenblatt
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
  If Target <> "" Then Sheets("" & Target.Value & "").Activate
End If
End Sub
Zu Deiner 2. Frage, schaue Dir mal folgende Seite an: http://www.xlam.ch/vbacode/vbacode5.htm#Externe%20Verkn%C3%BCpfungen%20in%20einer%20Arbeitsmappe%20auflisten
Gruß Jürgen
AW: Arbeitsblätternamen/Reiternamen auslesen
Overmind

Hallo Juergen,
das Tool "TabNamenAuflisten()" funktioniert super. Kann man das erweitern, dass er gleich eine Hyperlinkverknüpfung auf den Reiter z.B. Zelle A1 macht?.
Dann könnte man diese Auflistung wie ein Inhaltsverzeichnis nutzen.
Viele Grüsse und nochmals vielen Dank an alle.
Jan
Das hatte Dir gestern zwar schon in ...
Backowe

Hallo Jan,
... Teilstücken geschrieben, so jetzt das Ganze noch einmal zusammengefasst!
VBA-Code:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'Der Code kommt wieder in das Tabellenblatt
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" Then Sheets("" & Target.Value & "").Activate
  End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      Application.GoTo Reference:=Sheets("Tabelle1").Range("A1"), Scroll:=True
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Gruß Jürgen
AW: Das hatte Dir gestern zwar schon in ...
Overmind

Ja, das funktioniert super. Was passiert aber, wenn jemand einen Namen eine Reiters ändert. Das machen hier bei mir bei der Arbeit anscheinend Leute zum Hobby ;-).
Dann drohe den Leuten mit der Prügelstrafe! :)
Backowe

Hi Jan,
wird ein Tabellenname geändert, wird er beim Deaktivieren der Tabelle wieder auf den ursprünglichen Namen zurückgesetzt. Aber eine Manipulation ist natürlich möglich! ;o)
VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  'Code in die Tabelle!
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      MakroEinfuegen (Target.Value)
      Application.Goto Reference:=Sheets(1).Range("A1"), Scroll:=True
      Columns(1).Clear
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
      On Error Resume Next
      For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), Address:="#" & Range("A" & i).Value & "!A1", _
          TextToDisplay:=Range("A" & i).Value
      Next
      On Error GoTo 0
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Sub MakroEinfuegen(Tabellenname As String)
  'Code in ein Modul!
  Dim i As Integer
  With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    i = .CreateEventProc("Deactivate", "Worksheet")
    .InsertLines i + 1, "Me.Name = """ & Tabellenname & """"
  End With
End Sub
Gruß Jürgen
VBA Lösung
Tino

Hallo,
hier mal eine VBA Lösung.
kommt als Code in ein Modul
Option Explicit 
 
Function TabellenName(iIndex As Integer) As String 
 TabellenName = Sheets(iIndex).Name 
End Function 


In der Tabelle kannst Du dies nun wie eine Formel verwenden.
Tabelle1

 A
1Tabelle1
2Tabelle2

Formeln der Tabelle
ZelleFormel
A1=TabellenName(ZEILE($A1))
A2=TabellenName(ZEILE($A2))

Gruß Tino
Anzeige
AW: Arbeitsblätternamen/Reiternamen auslesen
29.06.2009 10:34:19
Overmind
Wie bekomme ich das zum Laufen? Will irgendwie ein Makro von mir haben?
Der Code kommt in die Tabelle!
29.06.2009 10:37:56
Backowe
Hi Jan,
rechte Maustaste auf Tabellenreiter, "Code anzeigen " auswählen und den Code in das rechte Fenster kopieren und VBA-Editor schliessen, dann sollte es funktionieren.
Gruß Jürgen
AW: Der Code kommt in die Tabelle!
29.06.2009 11:31:33
Overmind
Hi Jürgen,
super, vielen Dank!
Nochmals zu deinen Ersten Code: Funktioniert super!
******************************************

Sub TabNamenAuflisten()
Dim ws As Worksheet
Dim i As Integer
i = 1
For Each ws In Worksheets
Cells(i, "A") = ws.Name
i = i + 1
Next
End Sub


*********
Gibt es eine mgl. das die ich die Zeilen wie eine Inhaltsverzeichnis nutzen kann? D.h. das sie als Link gleich auf die Reiter funktionieren?
Noch eine anderen Frage, unabhängig von der obrigen. Ich muss mich gerade in viele Dateien einarbeiten, die unendlich miteinander verknüpft sind. Gibt es ein Tool, dass wie ein Chart zeigt, wie die Datei mit sämtlichen anderen Dateien verknüft ist. Sprich: aus der Datei die Info, aus der anderen die......
Gibt es so etwas?
Vielen Dank nochmals ,
Jan

Anzeige
AW: Der Code kommt in die Tabelle!
29.06.2009 11:46:19
Backowe
Hi Jan,
zu Deiner 1. Frage:
VBA-Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Der Code kommt wieder in das Tabellenblatt
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
  If Target <> "" Then Sheets("" & Target.Value & "").Activate
End If
End Sub
Zu Deiner 2. Frage, schaue Dir mal folgende Seite an: http://www.xlam.ch/vbacode/vbacode5.htm#Externe%20Verkn%C3%BCpfungen%20in%20einer%20Arbeitsmappe%20auflisten
Gruß Jürgen
AW: Arbeitsblätternamen/Reiternamen auslesen
Overmind

Hallo Juergen,
das Tool "TabNamenAuflisten()" funktioniert super. Kann man das erweitern, dass er gleich eine Hyperlinkverknüpfung auf den Reiter z.B. Zelle A1 macht?.
Dann könnte man diese Auflistung wie ein Inhaltsverzeichnis nutzen.
Viele Grüsse und nochmals vielen Dank an alle.
Jan
Das hatte Dir gestern zwar schon in ...
Backowe

Hallo Jan,
... Teilstücken geschrieben, so jetzt das Ganze noch einmal zusammengefasst!
VBA-Code:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'Der Code kommt wieder in das Tabellenblatt
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" Then Sheets("" & Target.Value & "").Activate
  End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      Application.GoTo Reference:=Sheets("Tabelle1").Range("A1"), Scroll:=True
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Gruß Jürgen
AW: Das hatte Dir gestern zwar schon in ...
Overmind

Ja, das funktioniert super. Was passiert aber, wenn jemand einen Namen eine Reiters ändert. Das machen hier bei mir bei der Arbeit anscheinend Leute zum Hobby ;-).
Dann drohe den Leuten mit der Prügelstrafe! :)
Backowe

Hi Jan,
wird ein Tabellenname geändert, wird er beim Deaktivieren der Tabelle wieder auf den ursprünglichen Namen zurückgesetzt. Aber eine Manipulation ist natürlich möglich! ;o)
VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  'Code in die Tabelle!
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      MakroEinfuegen (Target.Value)
      Application.Goto Reference:=Sheets(1).Range("A1"), Scroll:=True
      Columns(1).Clear
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
      On Error Resume Next
      For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), Address:="#" & Range("A" & i).Value & "!A1", _
          TextToDisplay:=Range("A" & i).Value
      Next
      On Error GoTo 0
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Sub MakroEinfuegen(Tabellenname As String)
  'Code in ein Modul!
  Dim i As Integer
  With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    i = .CreateEventProc("Deactivate", "Worksheet")
    .InsertLines i + 1, "Me.Name = """ & Tabellenname & """"
  End With
End Sub
Gruß Jürgen
VBA Lösung
Tino

Hallo,
hier mal eine VBA Lösung.
kommt als Code in ein Modul
Option Explicit 
 
Function TabellenName(iIndex As Integer) As String 
 TabellenName = Sheets(iIndex).Name 
End Function 


In der Tabelle kannst Du dies nun wie eine Formel verwenden.
Tabelle1

 A
1Tabelle1
2Tabelle2

Formeln der Tabelle
ZelleFormel
A1=TabellenName(ZEILE($A1))
A2=TabellenName(ZEILE($A2))

Gruß Tino
Anzeige
AW: Arbeitsblätternamen/Reiternamen auslesen
30.06.2009 10:31:21
Overmind
Hallo Juergen,
das Tool "TabNamenAuflisten()" funktioniert super. Kann man das erweitern, dass er gleich eine Hyperlinkverknüpfung auf den Reiter z.B. Zelle A1 macht?.
Dann könnte man diese Auflistung wie ein Inhaltsverzeichnis nutzen.
Viele Grüsse und nochmals vielen Dank an alle.
Jan
Das hatte Dir gestern zwar schon in ...
30.06.2009 10:53:37
Backowe
Hallo Jan,
... Teilstücken geschrieben, so jetzt das Ganze noch einmal zusammengefasst!
VBA-Code:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'Der Code kommt wieder in das Tabellenblatt
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" Then Sheets("" & Target.Value & "").Activate
  End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      Application.GoTo Reference:=Sheets("Tabelle1").Range("A1"), Scroll:=True
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Gruß Jürgen
AW: Das hatte Dir gestern zwar schon in ...
Overmind

Ja, das funktioniert super. Was passiert aber, wenn jemand einen Namen eine Reiters ändert. Das machen hier bei mir bei der Arbeit anscheinend Leute zum Hobby ;-).
Dann drohe den Leuten mit der Prügelstrafe! :)
Backowe

Hi Jan,
wird ein Tabellenname geändert, wird er beim Deaktivieren der Tabelle wieder auf den ursprünglichen Namen zurückgesetzt. Aber eine Manipulation ist natürlich möglich! ;o)
VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  'Code in die Tabelle!
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      MakroEinfuegen (Target.Value)
      Application.Goto Reference:=Sheets(1).Range("A1"), Scroll:=True
      Columns(1).Clear
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
      On Error Resume Next
      For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), Address:="#" & Range("A" & i).Value & "!A1", _
          TextToDisplay:=Range("A" & i).Value
      Next
      On Error GoTo 0
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Sub MakroEinfuegen(Tabellenname As String)
  'Code in ein Modul!
  Dim i As Integer
  With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    i = .CreateEventProc("Deactivate", "Worksheet")
    .InsertLines i + 1, "Me.Name = """ & Tabellenname & """"
  End With
End Sub
Gruß Jürgen
VBA Lösung
Tino

Hallo,
hier mal eine VBA Lösung.
kommt als Code in ein Modul
Option Explicit 
 
Function TabellenName(iIndex As Integer) As String 
 TabellenName = Sheets(iIndex).Name 
End Function 


In der Tabelle kannst Du dies nun wie eine Formel verwenden.
Tabelle1

 A
1Tabelle1
2Tabelle2

Formeln der Tabelle
ZelleFormel
A1=TabellenName(ZEILE($A1))
A2=TabellenName(ZEILE($A2))

Gruß Tino
Anzeige
AW: Das hatte Dir gestern zwar schon in ...
30.06.2009 11:32:21
Overmind
Ja, das funktioniert super. Was passiert aber, wenn jemand einen Namen eine Reiters ändert. Das machen hier bei mir bei der Arbeit anscheinend Leute zum Hobby ;-).
Dann drohe den Leuten mit der Prügelstrafe! :)
30.06.2009 15:15:34
Backowe
Hi Jan,
wird ein Tabellenname geändert, wird er beim Deaktivieren der Tabelle wieder auf den ursprünglichen Namen zurückgesetzt. Aber eine Manipulation ist natürlich möglich! ;o)
VBA-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  'Code in die Tabelle!
  Dim ws As Worksheet
  Dim i As Integer
  If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    If Target <> "" And SheetExists(Target) = False Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
      MakroEinfuegen (Target.Value)
      Application.Goto Reference:=Sheets(1).Range("A1"), Scroll:=True
      Columns(1).Clear
      i = 1
      For Each ws In Worksheets
        Cells(i, "A") = ws.Name
        i = i + 1
      Next
      On Error Resume Next
      For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), Address:="#" & Range("A" & i).Value & "!A1", _
          TextToDisplay:=Range("A" & i).Value
      Next
      On Error GoTo 0
    End If
  End If
End Sub
Public Function SheetExists(ByVal SheetName As StringAs Boolean
  On Error Resume Next
  SheetExists = (Sheets(SheetName).Name <> "")
  On Error GoTo 0
End Function
Sub MakroEinfuegen(Tabellenname As String)
  'Code in ein Modul!
  Dim i As Integer
  With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    i = .CreateEventProc("Deactivate", "Worksheet")
    .InsertLines i + 1, "Me.Name = """ & Tabellenname & """"
  End With
End Sub
Gruß Jürgen
VBA Lösung
Tino

Hallo,
hier mal eine VBA Lösung.
kommt als Code in ein Modul
Option Explicit 
 
Function TabellenName(iIndex As Integer) As String 
 TabellenName = Sheets(iIndex).Name 
End Function 


In der Tabelle kannst Du dies nun wie eine Formel verwenden.
Tabelle1

 A
1Tabelle1
2Tabelle2

Formeln der Tabelle
ZelleFormel
A1=TabellenName(ZEILE($A1))
A2=TabellenName(ZEILE($A2))

Gruß Tino
Anzeige
VBA Lösung
29.06.2009 08:29:52
Tino
Hallo,
hier mal eine VBA Lösung.
kommt als Code in ein Modul
Option Explicit 
 
Function TabellenName(iIndex As Integer) As String 
 TabellenName = Sheets(iIndex).Name 
End Function 


In der Tabelle kannst Du dies nun wie eine Formel verwenden.
Tabelle1

 A
1Tabelle1
2Tabelle2

Formeln der Tabelle
ZelleFormel
A1=TabellenName(ZEILE($A1))
A2=TabellenName(ZEILE($A2))

Gruß Tino
Anzeige

296 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige