Splitting multiple worksheet

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 splitting 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

---

i have posted this on other forum

http://www.excelforum.com/showthread.php?t=1172661&p=4576280&highlight=#post4576280

https://www.mrexcel.com/forum/excel-...worksheet.html