Create new sheet for each category based on unique values in a column and copy/paste

Hi all!

I'm very new to macros/VBA and trying to slowly teach myself so would really appreciate any help on this problem. I am trying to filter for each unique value in Column D and then create a new sheet (named after this unique value) to then copy across all the relevant data for this category. I've attached some example data so you can see the layout. You'll see there are merged cells in the data (do I need to adjust something else for this?)

My code is below but I am getting a runtime error 438 when I try to run this. It looks like the error is in this line: rngResults.SpecialCells(xlCellTypeVisible).Copy Destination:=Dest.Sheets(counter).Range("B8")

Thank you in advance for any help - very much appreciated!!

Sub MixedCodeAutoFilter()

Dim wbDest As Workbook
Dim rngFilter As Range, rngUniques As Range
Dim cell As Range, counter As Integer
Dim rngResults As Range 'filter range


Set rngFilter = Range("D8", Range("D" & Rows.Count).End(xlUp))
Set rngResults = Range("B8", Range("I" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False

With rngFilter
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUniques = Range("D9", Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

ActiveSheet.ShowAllData

End With


Set Dest = Worksheets.Add

For Each cell In rngUniques
counter = counter + 1
rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value
rngResults.SpecialCells(xlCellTypeVisible).Copy Destination:=Dest.Sheets(counter).Range("B8")
Dest.Sheets(counter).Name = cell.Value

Next cell
rngFilter.Parent.AutoFilterMode = False
Application.ScreenUpdating = True

End Sub

Hello Mr90,

I've taken the liberty to re-write the code entirely as follows:-

Please Login or Register  to view this content.

Yes, the merged cells are just nuisance value and need to be un-merged when used in VBA. Hence, with Sydney, you'll need to copy it down another couple of rows for the code above to work correctly.
The code will create and name new sheets based on the values in Column D and transfer all relevant rows of data to its individual sheet.

I hope that this helps.

Cheerio,
vcoolio.

Hi vcoolio

Thank you so much for this, really appreciated! I've copied this in and I am getting an error - "runtime error 13" in this line: "If Not Evaluate("ISREF('" & CStr(ar(i, 1)) & "'!A1)") Then"

Do you know what could be causing this?

Thanks