split data into multiple worksheets based on column with the help of VBA Code

[Basavaraj K H]

Dear All
http://www.extendoffice.com/documen...into-multiple-worksheets-based-on-column.html
How to split data(Zone wise) into multiple worksheets based on column with the help of VBA Code.
http://www.extendoffice.com/documen...into-multiple-worksheets-based-on-column.html
Kindly refer attachment.

Thanks in Advance.

Regards
Basavaraj K H

 

[Sathish KV]

Hi,

Use the below code

Sub Split()
  ActiveSheet.Cells(1, 1).Select
  ActiveCell.CurrentRegion.Select
  srcdata = ActiveCell.CurrentRegion.Address
 
 
 
  ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
  srcdata).CreatePivotTable TableDestination:="", _
  TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10
 
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
   
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Zone"), "Count of Zone", xlCount
       
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Zone")
        .Orientation = xlRowField
        .Position = 1
    End With
   
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Zone")
        .PivotItems("(blank)").Visible = False
    End With
   
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = False
        .RowGrand = False
    End With
   
    ActiveSheet.Name = "Pivot"
 
    Range("B5").Select
     
  Do While ActiveCell.Value <> ""
 
  Selection.ShowDetail = True
  ActiveSheet.Name = Range("B2").Value
  Range("A2").Select
  ActiveWindow.FreezePanes = True
  Sheets("Pivot").Select
  ActiveCell.Offset(1, 0).Select
  Loop
  Application.DisplayAlerts = False
  Sheets("Pivot").Delete
  Application.DisplayAlerts = True
End Sub

 

[Basavaraj K H]

Thank you Sathish,
but Sorry, I want split data of 1-Bangalore-1 to the another workbook
& same remaining 10 zone.

 

[Sathish KV]

Hi,

Can you mention the path where these created files will be saved

 

[Basavaraj K H]

to another workbook

 

[Sathish KV]

Hi,

Do you want to save the newly created files. If so can you mention the path

 

[Sathish KV]

Hi,

Use the below code

Note: Change the path name in the code as per your requirement

Sub Split()
  ActiveSheet.Cells(1, 1).Select
  ActiveCell.CurrentRegion.Select
  srcdata = ActiveCell.CurrentRegion.Address
  ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
  srcdata).CreatePivotTable TableDestination:="", _
  TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
 
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Zone"), "Count of Zone", xlCount
     
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Zone")
        .Orientation = xlRowField
        .Position = 1
    End With
 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Zone")
        .PivotItems("(blank)").Visible = False
    End With
 
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = False
        .RowGrand = False
    End With
 
    ActiveSheet.Name = "Pivot"
    Range("B5").Select
   
  Do While ActiveCell.Value <> ""
  Selection.ShowDetail = True
  ActiveSheet.Move
  ActiveSheet.Name = Range("B2").Value
  Range("A2").Select
  ActiveWindow.FreezePanes = True
  ActiveWorkbook.SaveAs Filename:="D:\New Folder\" & Range("B2").Text & ".xlsx", FileFormat:=xlNormal
  Activeworkbook.close
  ActiveCell.Offset(1, 0).Select
 
  Loop
 
End Sub