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
Thanks. It will be really useful.
ReplyDeleteThanks. It will be really useful.
ReplyDeleteCould you please explain this with an example? not able to visualize the input and output of your macri.
ReplyDelete