Hi there,
I've got a macro that take a value from a list(say ABC) from a sheet called "Names", creates a new worksheet called "ABC", runs a filter on column A in worksheet "Data" for cells containing "ABC", then copies and pastes those rows to the new worksheet "ABC". The problem is that the filter isn't working. It copies and pastes the entire source sheet, rather than filtered rows.
Please help me...I'm a total noob.
The code I have is:
Thanks very much for any assistance.
Cheers,
Peter
I've got a macro that take a value from a list(say ABC) from a sheet called "Names", creates a new worksheet called "ABC", runs a filter on column A in worksheet "Data" for cells containing "ABC", then copies and pastes those rows to the new worksheet "ABC". The problem is that the filter isn't working. It copies and pastes the entire source sheet, rather than filtered rows.
Please help me...I'm a total noob.
The code I have is:
Code:
Sub Create_Sheets()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Set wSheetStart = Sheets("SurveyData")
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
'Set rRange = Sheets("SurveyData").Range("A1", Range("A65536").End(xlUp))
On Error Resume Next
Application.DisplayAlerts = False
With Worksheets("Names")
'Set a range variable to the list of names, less the heading.
Set rRange = .Range("A2", .Range("A65536").End(xlUp))
End With
On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("A1").AdvancedFilter Action:=xlFilterCopy, _
Criteriarange:=strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'Copy the visible filtered range _
(default of Copy Method) and leave hidden rows
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
Next rCell
End With
With wSheetStart
.AutoFilterMode = False
.Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
Thanks very much for any assistance.
Cheers,
Peter