Reputation: 456
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
Reputation: 1
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
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