Create New Sheets from Filtered List - help on macro

T

Tea

Hi all,



I would appreciate help with VBA.

I am trying to edit VBA macro for creating new sheets from filtered list,
and i am somewhat stuck.

I managed to edit macro so that it filters column 4, but i dont know how to
write few lines of code so that macro does the following:



a.. On created sheets, at the bottom of the last column with data, to
summarize the data. Name of that coloumn will always be 'Grand Total'
b.. On 'UniqueList' sheet, VBA should name coloumn B:'Grand Total', and
paste appropriate 'Grand Total' value
c.. On sheet 'UniqueList', in the cell at the bottom of coloumn B, grand
total for created sheets should be summarized.


Thx in advance,

Goran





Sub PagesByDescription()

Dim rRange As Range, rCell As Range

Dim wSheet As Worksheet

Dim wSheetStart As Worksheet

Dim strText As String



Set wSheetStart = ActiveSheet

wSheetStart.AutoFilterMode = False

'Set a range variable to the correct item column

Set rRange = Range("d1", Range("d65536").End(xlUp))



'Delete any sheet called "UniqueList"

'Turn off run time errors & delete alert

On Error Resume Next

Application.DisplayAlerts = False

Worksheets("UniqueList").Delete



'Add a sheet called "UniqueList"

Worksheets.Add().Name = "UniqueList"



'Filter the Set range so only a unique list is created

With Worksheets("UniqueList")

rRange.AdvancedFilter xlFilterCopy, , _

Worksheets("UniqueList").Range("A1"), True



'Set a range variable to the unique list, 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").AutoFilter 4, 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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top