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.
[VBA]
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
[/VBA]
Reply With Quote
