1.I have this macro for splitting multiple worksheet , but if I freeze top 2 rows as header instead of 3 define in macro 1 blank row gets created I want to delete that row or can it be flexible
2.if I want to change the criteria column for splitting where should I change now it is column 1 can it be flexible
3.after spliting the file format of the file gets change I want the preserved the same format
2.if I want to change the criteria column for splitting where should I change now it is column 1 can it be flexible
3.after spliting the file format of the file gets change I want the preserved the same format
Code:
Sub test()
Dim ws As Worksheet, wb As Workbook
Dim a, e, i As Long, ii As Long, w, x
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For Each ws In Worksheets
a = ws.UsedRange.Value
ReDim w(1 To UBound(a, 2))
For i = 4 To UBound(a, 1)
If a(i, 1) = "" Then Exit For
If Not .exists(a(i, 1)) Then
Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
End If
If Not .Item(a(i, 1)).exists(ws.Name) Then
ReDim x(1 To 2)
Set x(1) = CreateObject("System.Collections.ArrayList")
Set x(2) = ws.UsedRange.Rows("1:2")
.Item(a(i, 1))(ws.Name) = x
End If
For ii = 1 To UBound(a, 2)
w(ii) = a(i, ii)
Next
.Item(a(i, 1))(ws.Name)(1).Add w
Next
Next
For Each e In .keys
Set wb = Workbooks.Add
For i = 0 To .Item(e).Count - 1
If i + 1 > wb.Sheets.Count Then
wb.Sheets.Add after:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Name = .Item(e).keys()(i)
Else
wb.Sheets(i + 1).Name = .Item(e).keys()(i)
End If
w = Application.Index(.Item(e).items()(i)(1).ToArray, 0, 0)
.Item(e).items()(i)(2).Copy wb.Sheets(.Item(e).keys()(i)).Cells(1)
wb.Sheets(.Item(e).keys()(i)).[a4] _
.Resize(UBound(w, 1), UBound(w, 2)).Value = w
Next
wb.SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
wb.Close
Next
End With
End Sub
