How to split Data one excel sheet into multiple sheets

How to split Data one excel sheet into multiple sheets using VBA

Suppose we have huge data in a single excel sheet and we have a task that data should be split into multiple excel sheet in that particular workbook by multiple criteria. Criteria may be in that data so we have to extract unique value from data. We have two option for doing this task first we do manually but it will take more time second we can use VBA code and it will do in quick time.

Split data into multiple worksheets

We will use FOR NEXT Loop for this task.

How can we do this task

We have to follow some steps

(1). First of all, we should disable Screen Updating and Display Alert. This may help to code run fast. This is not necessary but this is good practice for programming.

      Application.ScreenUpdating = False

      Application.DisplayAlerts = False

(2). After that, we should also change Calculation option automatic to Manual, if we do not use any function in excel sheet for calculation. This may also help to code run fast.

      Application.Calculation = xlCalculationManual

(2) . Declare the variable as per task

      Dim Unique_Data As Range

      Dim Unique_Data_Count As Integer

      Dim Total_Unique_Data As Integer

(3). After that, we are Assigning Range object as a reference to an object variable

      Set Unique_Data = Sheet1.Range(“A1:A” & _ Sheet1.Cells(Rows.Count,”A”).End(xlUp).Row)

(4). After that, We use Advance filter on Unique_Data. We get unique value and paste into separate range.

      Unique_Data.AdvancedFilter Action:=xlFilterCopy, copytorange:=Sheet1.Range(“L1”), unique:=True

(5). After that, We get total unique data which is extracted by the advanced filter.

      Total_Unique_Data = Sheet1.Cells(Rows.Count, “L”).End(xlUp).Row

(6). After that, We use For Next Loop for repeating our task as per total unique data.

      For Unique_Data_Count = 2 To Total_Unique_Data

(7). After that, We use Auto Filter and filter our data as per criteria which are extracted by an advanced filter.       

      Sheet1.Range(“A1:G1”).AutoFilter Field:=1, Criteria1:=Sheet1.Range(“L” & Unique_Data_Count)

(8). After that, we always add a sheet in the last place in the same workbook.         

      Sheets.Add after:=Sheets(Sheets.Count)

(9). After that, we can rename our sheet and name will be unique

      Sheets(Sheets.Count).Name = Sheet1.Range(“L” & Unique_Data_Count).Value

(9). After that, we copy the data in filter mode and we copy all visible cells. 

      Sheet1.Range(“A1”).SpecialCells(xlCellTypeVisible).CurrentRegion.Copy Sheets(Sheets.Count).Range(“A1”)

(10). After that, We can do auto fit our column for new added sheet. 

      Sheets(Sheets.Count).Columns.AutoFit

(11). After that, Use Next keyword for next variable value

      Next Unique_Data_Count

(12). After that, we can disable the filter mode in Master sheet

      Sheet1.AutoFilterMode = False

(13).After that, we should enable Screen Updating, Display Alert.

      Application.ScreenUpdating = True

      Application.DisplayAlerts = True

(14). After that, we should also change the Calculation option Manual to Automatic.

      Application.Calculation = xlCalculationAutomatic

 

How to split Data one excel sheet into multiple sheets

How to split Data one excel sheet into multiple sheets using VBA.

Here is full code to split data into the new sheet

Sub Split_Data()

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    Application.Calculation = xlCalculationManual

    Dim Unique_Data As Range

    Dim Unique_Data_Count As Integer

    Dim Total_Unique_Data As Integer   

    Set Unique_Data = Sheet1.Range(“A1:A” & Sheet1.Cells(Rows.Count, “A”).End(xlUp).Row)

    Unique_Data.AdvancedFilter Action:=xlFilterCopy, copytorange:=Sheet1.Range(“I1”), unique:=True

    Total_Unique_Data = Sheet1.Cells(Rows.Count, “I”).End(xlUp).Row

    For Unique_Data_Count = 2 To Total_Unique_Data   

        Sheet1.Range(“A1:G1”).AutoFilter Field:=1, Criteria1:=Sheet1.Range(“I” & Unique_Data_Count)

        Sheets.Add after:=Sheets(Sheets.Count)

        Sheets(Sheets.Count).Name = Sheet1.Range(“I” & Unique_Data_Count).Value

        Sheet1.Range(“A1”).SpecialCells(xlCellTypeVisible).CurrentRegion.Copy   

        Sheets(Sheets.Count).Range(“A1”)

        Sheets(Sheets.Count).Columns.AutoFit

    Next Unique_Data_Count

    Sheet1.AutoFilterMode = False

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

    Application.Calculation = xlCalculationAutomatic

End Sub

How to split Data one excel sheet into multiple sheets

How to split Data one excel sheet into multiple sheets using VBA.

Download Workbook

Consolidate Data in Excel from Multiple sheets Using VBA

 

Leave a Reply

Your email address will not be published. Required fields are marked *