Copy rows to another sheet
 

Hello. I have a worksheet with several thousand rows. In column F I
have an indicator column (Y or N). Is there a way to have vba scan
the entire sheet, find all rows that have a Y in column F, and copy
that row into the sheet named "Approved" beginning in row 3? And
every time the code is run, clear from row 3 down on the Approved
sheet and rewrite?

Thank you!

Copy rows to another sheet
 

Turn on the macro recorder while you use autofilter to find rows with Y in
column F.

Copy the resultant rows and paste to A3 in "Approved" sheet.

You could also record while clearing old data from "Approved".

Combine the two to clear "Approved" then filter and copy from source sheet.


Gord Dibben MS Excel MVP

On Fri, 29 Apr 2011 10:45:59 -0700 (PDT), Steve
wrote:

Hello. I have a worksheet with several thousand rows. In column F I
have an indicator column (Y or N). Is there a way to have vba scan
the entire sheet, find all rows that have a Y in column F, and copy
that row into the sheet named "Approved" beginning in row 3? And
every time the code is run, clear from row 3 down on the Approved
sheet and rewrite?

Thank you!

Copy rows to another sheet
 

try this

Sub kTest()

Dim ka, k(), i As Long, n As Long, c As Long, j As Long
Dim wks1 As Worksheet, UB1 As Long, UB2 As Long
Dim wks2 As Worksheet

Set wks1 = Sheets("Sheet1") 'adjust to suit
Set wks2 = Sheets("Approved")

ka = wks1.UsedRange
On Error Resume Next
c = Evaluate("countif(" & wks1.UsedRange.Columns(6).Address &
",""Y"")")
On Error GoTo 0
If c Then
UB1 = UBound(ka, 1)
UB2 = UBound(ka, 2)
ReDim k(1 To c, 1 To UB2)

For i = 1 To UB1
If LCase$(ka(i, 6)) = "y" Then
n = n + 1
For j = 1 To UB2
k(n, j) = ka(i, j)
Next
End If
Next
With wks2.Range("a3")
.Range(.Cells(1), .SpecialCells(11)).ClearContents
.Resize(n, UB2).Value = k
End With
End If

End Sub

Kris

Copy rows to another sheet
 

Steve formulated the question :
Hello. I have a worksheet with several thousand rows. In column F I
have an indicator column (Y or N). Is there a way to have vba scan
the entire sheet, find all rows that have a Y in column F, and copy
that row into the sheet named "Approved" beginning in row 3? And
every time the code is run, clear from row 3 down on the Approved
sheet and rewrite?

Thank you!

Try...

Dim wksSource As Worksheet, wksTarget As Worksheet

Set wksSource = ActiveSheet: Set wksTarget = Sheets("Approved")
Application.ScreenUpdating = False
With wksTarget
.Rows("3:" & CStr(.UsedRange.Rows.Count)).ClearContents
End With
With wksSource
.Columns("F:F").AutoFilter Field:=1, Criteria1:="Y"
.UsedRange.Copy wksTarget.Rows("3:3")
.Columns("F:F").AutoFilter
End With
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Copy rows to another sheet
 

Oops! Missed copying of 1st line...


Sub Test_CopyData1()
Dim wksSource As Worksheet, wksTarget As Worksheet

Set wksSource = ActiveSheet: Set wksTarget = Sheets("Approved")
Application.ScreenUpdating = False
With wksTarget
.Rows("3:" & CStr(.UsedRange.Rows.Count)).ClearContents
End With
With wksSource
.Columns("F:F").AutoFilter Field:=1, Criteria1:="Y"
.UsedRange.Copy wksTarget.Rows("3:3")
.Columns("F:F").AutoFilter
End With
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Copy rows to another sheet
 

Thanks Garry!

On May 1, 10:34*am, GS wrote:
Oops! Missed copying of 1st line...

Sub Test_CopyData1()
* Dim wksSource As Worksheet, wksTarget As Worksheet

* Set wksSource = ActiveSheet: Set wksTarget = Sheets("Approved")
* Application.ScreenUpdating = False
* With wksTarget
* * .Rows("3:" & CStr(.UsedRange.Rows.Count)).ClearContents
* End With
* With wksSource
* * .Columns("F:F").AutoFilter Field:=1, Criteria1:="Y"
* * .UsedRange.Copy wksTarget.Rows("3:3")
* * .Columns("F:F").AutoFilter
* End With
* Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Copy rows to another sheet
 

You're welcome, Steve!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc