Copy rows to another sheet

[Steve]

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!

 

[Gord Dibben]

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

 

[Kris]

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

 

[GS]

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

 

[GS]

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

 

[Steve]

Thanks Garry!

 

[GS]

You're welcome, Steve!