PDA

View Full Version : Solved: Adapt code by Tom Ogilvy



ndendrinos
08-05-2008, 02:45 PM
Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Filtered").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Filter").Range("A1")
End If
ActiveSheet.ShowAllData



Call MakeSheets
Call Niko
Call Changetovalues
End Sub
For each row in a filtered list a new ws is created.
In the first new ws the first row is pasted in A1.
In the second new ws the second row is pasted in A1
etc...

The last 3 "Call" introduce a template starting in A2 in each new sheet. The template has formulas that feed from the top row (A1) .
Then the formulas are converted to values.
What I would like to do is instead of creating all these new sheets to have the result on one sheet as per my example here.
Thank you