disneyfreak
New Member
- Joined
- Oct 8, 2014
- Messages
- 1
Have a macro that I just can't seem to get to work. I need to create seperate worksheets based on values in Column V and copy the data from each unique item to it's respective sheet. The macro below does create the new sheet but it does not copy the data and it errors out ShNew.Name = Item
Any assistance is greatly appreciated.
Sub parse()
Dim Sh As Worksheet
Dim Rng As Range
Dim c As Range
Dim List As New Collection
Dim Item As Variant
Dim ShNew As Worksheet
Application.ScreenUpdating = False
'
Set Sh = Worksheets("Staging")
Set Rng = Sh.Range("V2:V" & Sh.Range("V65536").End(xlUp).Row)
On Error Resume Next
For Each c In Rng
List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set Rng = Sh.Range("a1:w" & Sh.Range("Dw65536").End(xlUp).Row)
For Each Item In List
Set ShNew = Worksheets.Add
ShNew.Name = Item
Rng.AutoFilter Field:=1, Criteria1:=Item
Rng.EntireRow.SpecialCells(xlCellTypeVisible).copy ShNew.Range("A1")
Rng.AutoFilter
Next Item
Sh.Activate
Application.ScreenUpdating = True
End Sub
Any assistance is greatly appreciated.
Sub parse()
Dim Sh As Worksheet
Dim Rng As Range
Dim c As Range
Dim List As New Collection
Dim Item As Variant
Dim ShNew As Worksheet
Application.ScreenUpdating = False
'
Set Sh = Worksheets("Staging")
Set Rng = Sh.Range("V2:V" & Sh.Range("V65536").End(xlUp).Row)
On Error Resume Next
For Each c In Rng
List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set Rng = Sh.Range("a1:w" & Sh.Range("Dw65536").End(xlUp).Row)
For Each Item In List
Set ShNew = Worksheets.Add
ShNew.Name = Item
Rng.AutoFilter Field:=1, Criteria1:=Item
Rng.EntireRow.SpecialCells(xlCellTypeVisible).copy ShNew.Range("A1")
Rng.AutoFilter
Next Item
Sh.Activate
Application.ScreenUpdating = True
End Sub