Hi @
Shakti Bansal
Below you can find some code for separating the data based on the values in "B" and creating new workbooks... that said, I would advise against using it with so many unique values in "B", as it may take some time and slow your PC down significantly while doing it. In any case, it should work as intended:
Code:
Sub data_break()
Application.ScreenUpdating = False
Sheets.Add After:=ActiveSheet
With Sheets(1)
.Range("B2:B" & .Columns("B").Cells(Rows.Count).End(xlUp).Row).Copy Sheets(2).Cells(1, 1)
End With
Sheets(2).Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo
Dim NewWorkbook As Workbook
Dim ThisWorkbook As Workbook
Dim NewWorkbookName As String
Dim relativePath As String
Dim c As Range
Dim lastrow As Integer
Set ThisWorkbook = ActiveWorkbook
lastrow = Columns("B").Cells(Rows.Count).End(xlUp).Row
For Each c In Sheets(2).Range("A1:A" & Range("A1").End(xlDown).Row).Cells
NewWorkbookName = c.Value & ".xlsx"
Set NewWorkbook = Workbooks.Add
relativePath = ThisWorkbook.Path & "\" & NewWorkbookName
ActiveWorkbook.SaveAs Filename:=relativePath
With ThisWorkbook.Sheets(1)
If .FilterMode = True Then
.ShowAllData
End If
.Range("A1:X" & lastrow).AutoFilter Field:=2, Criteria1:=c.Value
.Range("A1:X" & Range("A1").End(xlDown).Row).Copy Workbooks(NewWorkbookName).Sheets(1).Cells(1, 1)
End With
Workbooks(NewWorkbookName).Close savechanges:=True
Next c
Application.DisplayAlerts = False
ThisWorkbook.Sheets(2).Delete
Application.DisplayAlerts = True
ThisWorkbook.Sheets(1).Range("A1").AutoFilter
Application.ScreenUpdating = True
End Sub
For the email part, since it is only one email, do you want to send all files at once or one email for each?
