Create sheets based on unique values in rows based on Primary Key - excel

Question

I am trying to populate multiple sheets based on the given data (attached Samplesheet SampleSheet.xlsx) as per the below rules:
Customer Code is the primary key, there should be each sheet for each unique customer code.
The new sheets should be named as "CustomerCode_Leads"
Every worksheet should have same headers.
I have started up with a logic and build a code behind but am lacking the knowledge on how to read the customer code data line by line, copy the rows with the same customer code and paste it in the sheet based on unique customer code.
Code written so far:
Sub Test()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Data")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
Selection.AutoFilter
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Select
Selection.Delete Shift:=xlUp
Application.Goto Reference:="R2C2"
ActiveCell.EntireColumn.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$5000").RemoveDuplicates Columns:=1, Header:=xlYes
Dim CurSheet As Worksheet
Dim Source As Range
Dim c As Range
Set CurSheet = ActiveSheet
Set Source = Selection.Cells
Application.ScreenUpdating = False
For Each c In Source
sName = Trim(c.Text)
If Len(sName) > 0 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sName + "_Leads"
End If
Next c
End Sub
Output Desired:
Can someone advise how to read the data row by row and paste it in a new worksheet named "CustomerCode_Lead" where "CustomerCode" is a variable with some values in the Data sheet.
The algorithm that I am following is:
Copy the datasheet and paste it into a new worksheet
Sort the data in ascending order based on Customer Code (it'll bring all the similar customer code together and ease the row by row reading)
Read the data row by row and copy the entire row and paste into a new sheet until the customer code stays the same, once different code arrives in the next row, it creates a new sheet named "CustomerCode_Leads"
Do the reading of data until the end of the data in the "Data" sheet.
I would absolutely thank you in advance for the help I'll get here from the community. :)

Answer 1

This is all you need:
Get all unique values of customer ID column
Filter data and copy to another sheet
It could look like below:
Option Explicit
Public Sub SplitDataByCustomerIntoSheets()
Dim wsData As Worksheet
Set wsData = ThisWorkbook.Worksheets("Data")
Dim LastRow As Long
LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
'creat unique list of customer codes (https://stackoverflow.com/questions/36044556/quicker-way-to-get-all-unique-values-of-a-column-in-vba)
Dim UniqueValues() As Variant
UniqueValues = wsData.Range("A2:A" & LastRow).Value
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim iRow As Long
For iRow = 1 To UBound(UniqueValues)
dict(UniqueValues(iRow, 1)) = Empty
Next
UniqueValues = WorksheetFunction.Transpose(dict.Keys())
'check if filter was already set
If wsData.FilterMode = False Then
wsData.Range("A1").AutoFilter
Else
wsData.ShowAllData
End If
Dim CustomerID As Variant
For Each CustomerID In UniqueValues 'loop through all customer IDs
With wsData.Range("A1:B" & LastRow) 'make sure to adjust B to the last column of your data
.AutoFilter Field:=1, Criteria1:=CustomerID 'filter by customer ID
'create a new sheet as last sheet and name it by customer ID
Dim NewSheet As Worksheet
Set NewSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
NewSheet.Name = CustomerID & "_Leads"
'copy visible cells of filtered data to new sheet
.SpecialCells(xlCellTypeVisible).Copy NewSheet.Range("A1")
End With
Next CustomerID
End Sub
Data sheet:
It will create a sheet for each customer ID like this: