Hi
after long time of the searching I've found this code splits data based on column A,B but my case need split based on columns are not adjacent like column B,D,F.
my knowladge in vba is too poor . so if anybody provide me to adapt this code with my requirement I truly appreciate .
Public Sub Split_Sheet_By_2_Columns()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim cellA As String, cellB As String, sheetName As String
Set wSheetStart = ActiveSheet
With wSheetStart
.AutoFilterMode = False
Set rRange = .Range("A1", .Range("B" & Rows.Count).End(xlUp))
End With
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete
Worksheets.Add().Name = "UniqueList"
On Error GoTo 0
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , Worksheets("UniqueList").Range("A1"), True
Set rRange = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
On Error Resume Next
With wSheetStart
For Each rCell In rRange
cellA = rCell.Value
cellB = rCell.Offset(, 1).Value
.Range("A1").AutoFilter 1, cellA
.Range("A1").AutoFilter 2, cellB
'Add a sheet named as A and B cells
sheetName = cellA & " " & cellB
Worksheets(sheetName).Delete
Worksheets.Add().Name = sheetName
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
Next rCell
End With
With wSheetStart
.AutoFilterMode = False
.Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
thanks in advance