Erstellung und Benennung von Tabellenblättern

[SimonVBA]

Hallo zusammen, 

die Ursprungsdatei besteht aus einer Tabelle in der in Spalte C (ab C3) mehrere Artikel aufgelistet sind. Durch ein Makro soll nun für jeden Artikel ein neues Tabellenblatt mit dem jeweiligen Namen erzeugt werden bis eine leere Zelle auftritt. 

Bis jetzt sieht der Code wie folgt aus: 

Code:

Sub Transfer()
      Dim x As Integer
      Application.ScreenUpdating = False' Set numrows = number of rows of data.

      NumRows = Range("C3", Range("C3").End(xlDown)).Rows.Count' Select cell C3.

      Range("C3").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 1 To NumRows
         
          'Creation of new sheets
         
         ActiveCell.Offset(1, 0).Select
      Next
      Application.ScreenUpdating = True
End Sub

In der Schleife fehlt jetzt noch die Erstellung der Tabellenblätter, habe bereits mehrere Möglichkeiten ohne Erfolg getestet. 

Kann mir da jemand behilflich sein?

Vielen Dank im Voraus
SimonVBA

[Werner.M]

Hallo,

Code:

Option Explicit

Public Sub Neue_Blätter()
Dim i As Long, ws As Worksheet

Application.ScreenUpdating = False

With Worksheets("Tabelle1") 'Blattname anpassen
    For i = 3 To .Cells(.Rows.Count, "C").End(xlUp).Row
        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(CStr(.Cells(i, "C")))
        On Error GoTo -1
        If ws Is Nothing Then
            Worksheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = .Cells(i, "C")
        End If
    Next i
    .Activate
End With

Set ws = Nothing 
End Sub

Ob das Blatt, das neu angelegt werden soll, schon vorhanden ist, wird geprüft.

Achtung: Es erfolgt keine Prüfung ob der Blattname aus der jeweiligen Zelle ungültige Zeichen enthält oder zu lang ist.

Gruß Werner

[SimonVBA]

Hallo Werner, 

klappt wunderbar. Vielen Dank. 

Hab jetzt noch einen Code vorgeschaltet der die Sonderzeichen aus der Spalte entfernt.  

Viele Grüße
Simon