AW: Arbeitsblätter erstellen mittels Liste
16.03.2010 15:47:04
Detlef
Hallo Sven,
folgender Code kommt in Tabelle5 (Dein LayoutMuster):
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'** Übergabe des Zellbereichs und der Zellbezeichnung
'** an die Prozedur TabellenreiterUmbenennen
TabellenreiterUmbenennen Target, "A2"
End Sub
Folgendes in ein Modul:
Modul modTabellenAnlage
Option Explicit
Sub procTabellenAnlage()
Dim intAnz As Integer, intRow As Integer
On Error Resume Next
With Sheets("Agenda")
intRow = .Cells(Rows.Count, 1).End(xlUp).Row
For intAnz = 2 To intRow
Sheets("Tabelle5").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Cells(2, 1) = Sheets("Agenda").Cells(intAnz, 1)
ActiveSheet.Cells(3, 1) = Sheets("Agenda").Cells(intAnz, 2)
ActiveSheet.Cells(4, 1) = Sheets("Agenda").Cells(intAnz, 5) _
& "_" & Sheets("Agenda").Cells(intAnz, 6)
Next intAnz
End With
End Sub
Und folgender in ein weiteres Modul:
Modul modAutoTabName
Option Explicit
Sub TabellenreiterUmbenennen(ByVal rngZelle As Range, strZellAdresse As String)
On Error GoTo fehler
Dim intAntwort As Integer
Dim strTabellenblatt As String
Dim xlWS As Worksheet
'** Wenn die übergebene Adresse der Adresse des aktiven Tabellenblatts entspricht
If rngZelle.Address = ActiveSheet.Range(strZellAdresse).Address Then
'** Übernahme des Zellinhalts in die Variable strTabellenblatt
strTabellenblatt = rngZelle.Text
'** Überprüfen ob der Tabellenblattbezeichner nicht zu lang ist
If Len(strTabellenblatt) > 31 Then
strTabellenblatt = Left(strTabellenblatt, 31)
MsgBox "Der Tabellenblattbezeichner ist zu lang" & vbCrLf & _
" und wird auf 31 Zeichen verkürzt", vbInformation
End If
'** Unerlaubte Zeichen befinden durch einen Unterstrich ersetzen
strTabellenblatt = Replace(strTabellenblatt, ":", "_")
strTabellenblatt = Replace(strTabellenblatt, "\", "_")
strTabellenblatt = Replace(strTabellenblatt, "/", "_")
strTabellenblatt = Replace(strTabellenblatt, "?", "_")
strTabellenblatt = Replace(strTabellenblatt, "*", "_")
strTabellenblatt = Replace(strTabellenblatt, "[", "_")
strTabellenblatt = Replace(strTabellenblatt, "]", "_")
'** Prüfen, ob es sich um den Tabellenblattbezeichner der
'** aktiven Tabelle handelt
If Not ActiveSheet.Name = strTabellenblatt Then
'** Durchlaufen aller Tabellenblätter
For Each xlWS In Worksheets
'** Falls es den zu vergebenden Tabellenblattbezeichner schon gibt ...
If xlWS.Name = strTabellenblatt Then
'** ... Ausgeben einer Meldung
MsgBox "Tabllenname: " & strTabellenblatt & " existiert bereits" & vbCrLf & "Tabellenblatt wurde nicht umbenannt!", vbExclamation
'** Verlassen der Prozedur, ohne eine Änderung vorzunehmen
Exit Sub
End If
Next
'** Überprüfen, ob die Variable einen Inhalt hat
If strTabellenblatt <> "" Then
'** Ist das der Fall, abfragen ob umbenannt werden soll.
'** Aktiviert wird die zweite Schaltfläche der MsgBox, um ein vorschnelles
'** Umbenennen durch ein unbeabsichtigtes Bestätigen zu vermeiden
' intAntwort = MsgBox("Soll der Tabellenreiter umbenannt werden?", vbQuestion + vbYesNo + vbDefaultButton2)
'** Wenn die Schaltfläche JA betätigt wurde
' If intAntwort = vbYes Then
'** Vergabe eines neuen Tabellenblattbezeichners
ActiveSheet.Name = strTabellenblatt
' End If
End If
End If
End If
Exit Sub
fehler:
MsgBox Err.Description
End Sub
Ausgangspunkt ist der Code procTabellenAnlage
Gruß Detlef
*** RückInfo wäre nett ***