Tabblad dmv macro opsplisten in meerdere tabbladen

[Ron Veenstra]

Goedemiddag,
Ik heb een tabblad met op regel 1 de kolomnamen met daaronder de gegevens.
Nu wil ik graag d.m.v. een macro dit tabblad splitsen in meerdere tabbladen op basis van naam.
Het tabblad wil ik graag de naam van de persoon mee geven.

Dus in iedere tabblad wil ik regel 1 de kolomnamen terug zien en daaronder de gevens van de persoon.

Ik heb een voorbeeld bestandje meegestuurd.

Alvast bedankt.

 

[HSV]

In een standaardmodule.

Sub hsv()
Dim cl As Range, sNaam As String, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Bron" Then
   ws.Cells.Clear
  End If
Next ws
 For Each cl In Sheets("Bron").Columns(2).SpecialCells(2).Offset(1)
  sNaam = cl
   If cl > 0 Then
If Not SheetExists(sNaam) Then
 Sheets.Add after:=Sheets(Sheets.Count)
  With ActiveSheet
   .Name = cl
   .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = cl.Offset(, -1).Resize(, 4).Value
  End With
Else
 Sheets(sNaam).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = cl.Offset(, -1).Resize(, 4).Value
    End If
  End If
 Next cl
End Sub


Function SheetExists(sNaam As String) As Boolean
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Worksheets
    If sht.Name = sNaam Then
        SheetExists = True
        Exit For
    End If
 Next
End Function

 

[HSV]

Ook een manier van dank je wel.