Office: Makro zur Vervielfertigung von Arbeitsblätter

Guten Tag an alle user,

Ich bin auf der Suche nach einem Makro folgenden Eigenschaften.
Im Arbeitsblatt "Contents" sind im Zellenbereich "D9 : D88"
verschiedene Bezeichnungen.
Für jede Bezeichnung soll ein Arbeitsblatt erstellt und mit dem
Ihnhalt aus dem Arbeitsblatt "Vorlage" gefüllt werden.
So soll per Makro 79 Arbeitsblätter mit unterschiedlicher Bezeichnung und dem Ihnhalt
der Vorlage entstehen.

Ich hoffe die community kann mir helfen !!!

 

Hallo,

ich habe Dir in der beiliegenden Excel-Datei 2 Arbeitsblätter eingebaut, wovon
1) das Blatt "Vorlage" dasjenige mit Deiner Vorlage sein sollte. Es enthält momentan nur einen Ersatztext.
2) das Blatt "Contents" den Bereich D9:D88 enthält mit den Namen der anzufügenden Arbeitsblätter. Leere Namenszellen werden durch das Makro mit Ersatznamen aufgefüllt.
Durch Klick auf den Button wird das Makro gestartet und die 80 Arbeitsblätter mit dem Inhalt des Blattes "Vorlage" und dem Namen aus der Blattnamensliste werden erzeugt.

 

Hi Tobi,

hier ein Code, der berücksichtigt, ob alle Zellen im Bereich D9: D88 einen Inhalt haben, ob die Länge des Zellinhaltes 31 nicht übersteigt, ob ungültige Inhalte für die Benennung der Tabellenblätter enthalten sind und ob das zu erstellende Tabellenblatt nicht bereits vorhanden ist. Sind alle für die Erstellung und Benennung von Tabellenlättern relevanten Bedingungen eingehalten, wird es erstellt - andernfalls nicht:

Code:

Sub TabsErzeugen()
   Dim lngZeile As Long
   With Worksheets("Contents")
      For lngZeile = 9 To 88
         ' Zelle ist nicht leer
         If .Cells(lngZeile, 4) <> "" Then
            ' Länge ist kleiner 32
            If Len(lngZeile) < 32 Then
               ' Celle enthält keinen ungültige Ausdruck
               If InStr(.Cells(lngZeile, 4), "\") = 0 And InStr(.Cells(lngZeile, 4), "/") = 0 And InStr(.Cells(lngZeile, 4), "?") = 0 _
                  And InStr(.Cells(lngZeile, 4), "*") = 0 And InStr(.Cells(lngZeile, 4), "[") = 0 And InStr(.Cells(lngZeile, 4), "]") = 0 Then
                  ' Tabellenblatt ist noch nicht vorhanden
                  If IsError(Evaluate("='" & .Cells(lngZeile, 4) & "'!A1")) Then
                     ' Vorlage kopieren und ans Ende stellen
                     Worksheets("Vorlage").Copy after:=Worksheets(Worksheets.Count)
                     ' letztes Tabellenblatt aus laufender Zelle benennen
                     Worksheets(Worksheets.Count).Name = .Cells(lngZeile, 4)
                  End If
               End If
            End If
         End If
      Next lngZeile
   End With
End Sub

Bis später,
Karin

 

Danke euch beiden,

ich wollte auch gern die Bezeichnung des Arbeitsblattes
in einer Zelle (gleiches Arbeitsblatt) darstellen.
Wollte es mir einfach machen und habe in dem Arbeitsblatt "Vorlage"
in die Zelle die Funktion = Blattname() erstellt.

Function Blattname() As String
Blattname = ActiveSheet.Name
End Function

Dies funz aber nicht weil, dann in den erstellten Arbeitsblätter
die funktion nicht aktualisiert wird.

Weis jemand Rat ???

 

Hi,

weshalb so kompliziert? Schreibe einfach in die Zelle (z.B. A1) diese Formel: =TEIL(ZELLE("Dateiname";$A$1);FINDEN("]";ZELLE("Dateiname";$A$1))+1;31)

Hinweis: Arbeitsmappe muss schon mal gespeichert sein, andernfalls erhält man einen Fehler.

Bis später,
Karin