-
10$ For VBA Code Split Data To Multiple Workbook Based On Unique Values In A Column
-
-
i also worked out this code but it creates the workbooks but somehow some of the data is missing on those created workbooks
Code:
Sub DistributeRowsToNewWBS()
Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
Set wsData = Worksheets("Expenditure_Details") ' name of worksheet with the data
Set wsCrit = Worksheets.Add
LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
' column H has the criteria
wsData.Range("p1:p" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
Set rngCrit = wsCrit.Range("A2")
While rngCrit.Value <> ""
Set wsNew = Worksheets.Add
' change E to reflect columns to copy
wsData.Range("A1:bp" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
wsNew.Name = rngCrit
wsNew.Copy
Set wbNew = ActiveWorkbook
' saves new workbook in path of existing workbook
wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit
wbNew.Close SaveChanges:=True
Application.DisplayAlerts = False
wsNew.Delete
rngCrit.EntireRow.Delete
Set rngCrit = wsCrit.Range("A2")
Wend
wsCrit.Delete
Application.DisplayAlerts = True
End Sub
-
please let me know if this is possible, otherwise, please delete the thread. thanks.
-
Here's the code. Run this from within the source workbook
Code:
Sub SplitWorkbook()
Dim colLetter As String, SavePath As String
Dim lastValue As String
Dim wb As Workbook
Dim lng As Long
Dim currentRow As Long
colLetter = "P"
SavePath = "" 'Indicate the path to save
If SavePath = "" Then SavePath = ThisWorkbook.Path
'Sort the workbook.
With ThisWorkbook.Worksheets(1)
.Sort.SortFields.Add Key:=.Range(colLetter & ":" & colLetter), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For lng = 2 To .Range(colLetter & .Rows.Count).End(xlUp).Row
If .Cells(lng, colLetter).Value = "" Then Exit For
lastValue = .Cells(lng, colLetter).Value
.Cells.AutoFilter field:=.Cells(lng, colLetter).Column, Criteria1:=lastValue
lng = .Cells(.Rows.Count, colLetter).End(xlUp).Row
Set wb = Application.Workbooks.Add(xlWorksheet)
.Rows(1 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
wb.SaveAs SavePath & "\" & lastValue, 50
wb.Close
Next
.AutoFilterMode = False
End With
End Sub
-
1 Attachment(s)
Attachment 780
this code did not work. it gives two errors one. worksheet error
and also vba run time error 1004 debugger stops at with Sort .apply
-
Works absolutely fine at my side. For the resources issue, try restarting your computer, and then run the code.
-
I get 43 xlsb files as output
-
1 Attachment(s)
Attachment 781
i restarted and tried again. still get the same error. also the runtime error
do i need to add any reference from the object library?
Code:
Sub SplitWorkbook()
Dim colLetter As String, SavePath As String
Dim lastValue As String
Dim wb As Workbook
Dim lng As Long
Dim currentRow As Long
colLetter = "P"
SavePath = "" 'Indicate the path to save
If SavePath = "" Then SavePath = ThisWorkbook.Path
'Sort the workbook.
With ThisWorkbook.Worksheets(1)
.Sort.SortFields.Add Key:=.Range(colLetter & ":" & colLetter), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For lng = 2 To .Range(colLetter & .Rows.Count).End(xlUp).Row
If .Cells(lng, colLetter).Value = "" Then Exit For
lastValue = .Cells(lng, colLetter).Value
.Cells.AutoFilter field:=.Cells(lng, colLetter).Column, Criteria1:=lastValue
lng = .Cells(.Rows.Count, colLetter).End(xlUp).Row
Set wb = Application.Workbooks.Add(xlWorksheet)
.Rows(1 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
wb.SaveAs SavePath & "\" & lastValue, 50
wb.Close
Next
.AutoFilterMode = False
End With
End Sub
Quote:
Originally Posted by
Excel Fox
I get 43 xlsb files as output
-
what version excel r u using?
