Werte auf Blätter verteilen

Thema: Allgemein - Gruppe Arbeitsblatt

Arbeitsmappe

033198    240004

Problem: Für jede Gruppe ist im Blatt BlattIndex ein Tabellenblattname hinterlegt. Die einzelnen Datensätze sollen nach diesem Index auf die Tabellenblätter verteilt werden.

StandardModule: Modul1

Sub BlaetterAnlegen()
   Dim iWks As Integer
   For iWks = 1 To 6
      Worksheets.Add after:=Worksheets(Worksheets.Count)
      ActiveSheet.Name = Worksheets("BlattIndex").Cells(iWks, 2).Value
   Next iWks
   Worksheets(1).Select
End Sub

Sub Eintragen()
   Dim vRow As Variant
   Dim iRow As Integer, iRowT As Integer
   iRow = 2
   Do Until IsEmpty(Cells(iRow, 1))
      vRow = Application.Match(Cells(iRow, 1).Value, Worksheets("BlattIndex").Columns(1), 0)
      If Not IsError(vRow) Then
         With Worksheets(Worksheets("BlattIndex").Cells(vRow, 2).Value)
            iRowT = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Rows(iRowT).Value = Rows(iRow).Value
         End With
      End If
      iRow = iRow + 1
   Loop
End Sub