Results 1 to 4 of 4

Thread: Multiple sheet splitting

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Junior Member
    Join Date
    Oct 2016
    Posts
    3
    Rep Power
    0

    Multiple sheet splitting

    i have a macro as below of splitting multiple sheets but after splitting the formatting gets changed and freeze column also not reflecting i want to keep formatting ,header,aliment and freezing as the main sheet can it is possible

    The same has been posted in other forum as link below
    https://www.mrexcel.com/forum/excel-...splitting.html


    Code:
    Sub test()
        Dim ws As Worksheet, a, e, i As Long, ii As Long, w, wb As Workbook
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For Each ws In Worksheets
                a = Intersect(ws.Rows("3:" & Rows.Count), _
                ws.Range("a3").CurrentRegion).Value
                ReDim w(1 To UBound(a, 2))
                For i = 2 To UBound(a, 1)
                    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
                        Set .Item(a(i, 1))(ws.Name) = _
                        CreateObject("System.Collections.ArrayList")
                        For ii = 1 To UBound(a, 2)
                            w(ii) = a(1, ii)
                        Next
                        .Item(a(i, 1))(ws.Name).Add w
                    End If
                    For ii = 1 To UBound(a, 2)
                        w(ii) = a(i, ii)
                    Next
                    .Item(a(i, 1))(ws.Name).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).ToArray, 0, 0)
                    wb.Sheets(.Item(e).keys()(i)).Cells(1) _
                    .Resize(UBound(w, 1), UBound(w, 2)).Value = w
                Next
                wb.SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
                wb.Close
            Next
        End With
    End Sub
    Attached Files Attached Files

Similar Threads

  1. Replies: 2
    Last Post: 02-27-2019, 05:35 PM
  2. Replies: 2
    Last Post: 07-20-2017, 07:32 AM
  3. Splitting userform text onto different rows
    By achar in forum Excel Help
    Replies: 1
    Last Post: 02-21-2015, 07:04 PM
  4. Splitting and merging files with VBA
    By tryingtocode in forum Excel Help
    Replies: 1
    Last Post: 05-23-2013, 10:37 PM
  5. Combine Columns From Multiple Sheets To One Sheet
    By Portucale in forum Excel Help
    Replies: 6
    Last Post: 04-24-2013, 09:18 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •