John
John

Reputation: 456

VBA to split data into multiple sheet keeping the same layout and Formulas

I inherited a VBA code that Split data into multiple sheets in excel based on column value. But when run the code, it splits the data into multiple sheets but the format changes and the formulas don't get copied. I am also wondering if it is possible to copy into different workbooks instead of separate sheets. Any help is appreciated.

Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer

    vcol = 8

    Set ws = Sheets("Sheet1")

    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A11:H11"
    titlerow = ws.Range("A1:H1").Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"

    For i = 2 To lr
        On Error Resume Next

        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next

    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear

    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""

        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If

        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
        Sheets(myarr(i) & "").Columns.AutoFit
    Next

    ws.AutoFilterMode = False
    ws.Activate
End Sub

Upvotes: 1

Views: 2806

Answers (2)

Replace

ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit

With

ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy
With Sheets(myarr(i) & "").Range("A1")
.PasteSpecial xlPasteFormulas
.PasteSpecial xlPasteFormats
.Columns.AutoFit
End With

Upvotes: 0

Mistella
Mistella

Reputation: 1738

Since you mentioned that the formulas don't get copied, I suspect it has to do with the following line of code:

myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))

Within the Transpose function, there is: ws.Columns(icol).SpecialCells(xlCellTypeConstants)

.SpecialCells is used to select only specific types of cells. I've used it before to select the last used cell or only the visible cells of a selected range. The value used in your code (xlCellTypeConstants), selects only the cells with constants as a value (any cell without a formula).

If you are not purposefully limiting those ranges to cells with only constants, I would just get rid of the .SpecialCells(xlCellTypeConstants). If you are trying to select a specific type of cell, I would recommend following the link below for the listing of values and what they do.

https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-specialcells-method-excel

On the other hand

If that portion of the code is actually doing what you want it to, instead of using a plain copy in this line:

ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")

you could try looking into the .PasteSpecial method for Ranges, and see if that will work for you. I know .PastSpecial can be used to paste only formulas, but I believe there's settings for other types of behavior as well. Such as the xlPasteAll or the xlPasteFormats.

Copying to a different workbook

It's possible. If you want to paste into a new workbook, there is a Workbook.Add method, although I haven't used it much. If you have an existing workbook you are copying to, you need to know that workbook's address to open it, or it's name to reference it if it's already open. You will also need to specify which workbook before the sheet(s); in the same way that you specify which sheet before the cells. However, you will need to make sure to specify which workbook you're referencing before any sheet references, for as long as you have at least two different workbooks open. Otherwise the code will go with the active workbook, which can give unexpected results.

Although

In my experiance, if you're trying to copy and paste a larger amount of information, it's faster to copy/Paste to another worksheet in the same workbook, and then move/copy that worksheet to the other workbook.

Upvotes: 1

Related Questions