Clever-Excel-Forum

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

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

Hallo Werner,

klappt wunderbar. Vielen Dank.

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

Viele Grüße
Simon

SimonVBA

Werner.M

SimonVBA