Multiple sheet splitting

[sachin483]

I have a macro splitting multiplte sheet depending on coloumn (A) in all the sheets and freezing top 2 rows


while runnig the macro error reflecting
Runtime Error 1004
Cannot rename a sheet to the same name as another
and the macro not executing


can it be done to flexible with freezing the top 2 or 3 rows freezing and the rows can be merged also and format also gets change

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 = 3 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)).[a3] _
                .Resize(UBound(w, 1), UBound(w, 2)).Value = w
            Next
            wb.SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
            wb.Close
        Next
    End With
End Sub

 

[sachin483]

Can somebody help me out as I have to split many sheets