Tuesday 8 March 2016

Split data in multiple workbooks based on a column

Here, I could find this as the fastest method to split data in multiple workbooks, based on a column values. Irrespective of no. of rows or columns, this will always work.. Wow!!

Sub split()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String
Dim wb As Workbook
On Error Resume Next
Set r = Range("C1")    ''Here you can change C to any column, basis which you want to split
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveSheet
    Master = .Name
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 2
    For i = 2 To LastRow
        If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
            iEnd = i
            
            Workbooks.Add
         
            Set wb = ActiveWorkbook
            wb.SaveAs Filename:=ThisWorkbook.Path & "\" & .Cells(iStart, iCol).Value & ".xls" 
            On Error Resume Next
           
            On Error GoTo 0
            Set ws = wb.Worksheets(1)
            ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
            .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
            iStart = iEnd + 1
            ActiveWorkbook.Close True
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Completed in " & Format(Now - t, "hh:mm:ss.00"), vbInformation

     Application.ScreenUpdating = True

End Sub