Separating data and placing in individual worksheets Excel VBA [closed]

Answer 1

I tried this code out and it worked for me.

This will split the data (based on unique name) and paste it into a separate worksheet that will be named the same as the name in column A.

Sub SplitData()
    Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long

    Set Names = Range("A2:A" & Range("A1").End(xlDown).Row)
    n = 0

    DeleteWorksheets

    For Each name In Names
        If name.Offset(1, 0) <> name Then
            ReDim Preserve DataMarkers(n)
            DataMarkers(n) = name.Row
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
            n = n + 1
        End If
    Next name

    For i = 0 To UBound(DataMarkers)
        If i = 0 Then
            Worksheets(1).Range("A2:C" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A1")
        Else
            Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & ":C" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A1")
        End If
    Next i
End Sub

Sub DeleteWorksheets()
    Dim ws As Worksheet, activeShtIndex As Long, i As Long

    activeShtIndex = ActiveSheet.Index

    Application.DisplayAlerts = False
    For i = ThisWorkbook.Worksheets.Count To 1 Step -1
        If i <> activeShtIndex Then
            Worksheets(i).Delete
        End If
    Next i
    Application.DisplayAlerts = True
End Sub

What I am doing in this code is:

1. Delete all worksheets apart from the one with the initial data table
2. Work down the 'Name' column and create an array of 'markers' that indicate where each data split is
3. Create a new worksheet and copy the data to it based on the values in the array