Copy rows to another sheet

  • Thread starter Thread starter Steve
  • Start date Start date
S

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!
 
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
 
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
 
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!
Click to expand...

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
 
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
 
Back
Top