Autofiltered values to a new sheet

[sindhuja]

I have a sheet named details in which i need to filter the column P which contains value *park* and copy the filtered values to sheet named park.

again show all data in column p and filter in colum Q, copy the results in sheet park after the last used row. The same thing in column R,.

can some one assist with this requirement.

i tried the below code but the results are in seperate sheet but i need in the same sheet that too only with the word *park* as criteria.



Option Explicit

Public Sub MoveToTab()
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range

On Error GoTo ErrHnd

With Worksheets("Details")
'set start as A2 i.e., after heading row in column A
Set rngStart = .Range("A1")
'set end - last used row in column Q
Set rngEnd = .Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'loop through cells in column A
For Each rngCell In Range(rngStart, rngEnd)
'test if tab exists
On Error Resume Next
If Not Worksheets(rngCell.Text).Name <> "" Then
On Error GoTo ErrHnd
'No worksheet of this name - so create one and copy row
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = rngCell.Text
rngCell.EntireRow.Copy Destination:=Worksheets(rngCell.Text).Range("A1")
Else
On Error GoTo ErrHnd
'worksheet exists
'copy row to end of used range
rngCell.EntireRow.Copy Destination:=Worksheets(rngCell.Text).Range("A1") _
.Offset(Worksheets(rngCell.Text).UsedRange.Rows.Count, 0)
End If
Next rngCell
End With
Exit Sub

'error handler
ErrHnd:
Err.Clear
End Sub

[shrivallabha]

Hi,

You can use macro recorder to get this done. The resultant macro can then be edited to suit your requirements.

So record the macro and post back your code.

[sindhuja]

Sub Macro1()
'
' Macro1 Macro
'

'
Range("AS1").Select
ActiveSheet.Range("$A$1:$BX$4153").AutoFilter Field:=42, Criteria1:= _
"=*park*", Operator:=xlAnd
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Copy
ActiveWindow.SmallScroll Down:=117
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Range("A1").Select
Sheets("Sheet").Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Range("AS1").Select
ActiveSheet.Range("$A$1:$BX$4153").AutoFilter Field:=43, Criteria1:= _
"=*park*", Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-12
Rows("148:148").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=9
Range("A928").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=21
Range("A1").Select
Sheets("Sheet").Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Range("AR1").Select
ActiveSheet.Range("$A$1:$BX$4153").AutoFilter Field:=44, Criteria1:= _
"=*park*", Operator:=xlAnd
Rows("294:294").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet3").Select
ActiveWindow.SmallScroll Down:=-15
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=18
Range("A955").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
With Selection.Font
.Name = "Arial"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Cells.Select
ActiveWindow.DisplayGridlines = False
Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub

Here is the recorded macro. Number of rows varies in sheet and as well as in sheet3

[shrivallabha]

Lightly tested. It seems that you have added a sheet for your report. So I have continued with the same idea.
Sub Macro1_Edited()
Dim lLastRow As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

With ActiveSheet
lLastRow = .Range("A" & Rows.Count).End(xlUp).Row

.Range("$A$1:$BX$" & lLastRow).AutoFilter Field:=42, Criteria1:= _
"=*park*", Operator:=xlAnd

Set ws = Sheets.Add(After:=Sheets(Sheets.Count))

With .Range("$A$1:$BX$" & lLastRow)
.SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("A1")
End With

.ShowAllData
.Range("$A$1:$BX$" & lLastRow).AutoFilter Field:=43, Criteria1:= _
"=*park*", Operator:=xlAnd

With .Range("$A$2:$BX$" & lLastRow)
.SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("A" & Rows.Count).End(xlUp)(2)
End With

.ShowAllData
.Range("$A$2:$BX$4153").AutoFilter Field:=44, Criteria1:= _
"=*park*", Operator:=xlAnd

With .Range("$A$2:$BX$" & lLastRow)
.SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("A" & Rows.Count).End(xlUp)(2)
End With
End With

ws.Cells.Borders.LineStyle = xlNone

With ws.UsedRange
.EntireColumn.AutoFit
With .Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With .Borders
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With

ws.Activate
ActiveWindow.DisplayGridlines = False

Application.ScreenUpdating = True

End Sub

[sindhuja]

Thank you so much... let me try this and get back to you if i need any assistance..