Find all rows that = X and copy to other sheet? Only finds first?

Same problem different code?

Sub Priority()
'Find all the rows ("A:G") that have a "X" in column "A" copy
'that row to the next blank row on a different sheet.
A = 1
Application.ScreenUpdating = False
myDo:
A = A + 1
With Worksheets("Want_Full")
If Cells(A, 1) = "X" Then
Application.CutCopyMode = False
.Range(Cells(A, 1), Cells(A, 7)).Copy Destination:=Worksheets("Want_Now").Range("A65536").End(xlUp)
If Not Cells(A, 1) = "" Then GoTo myDo Else GoTo myEnd
myEnd:
Application.ScreenUpdating = True
End If
End With
End Sub

Joe, why don't you...

...ditch this looping, copying, and pasting for
Advanced AutoFiltering...

Range("A1:C6").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"E1:E2"), CopyToRange:=Range("Sheet2!A1"), Unique:=False

This one statement examines cell range A1:C6 which
contains...

{"Field1","Field2","Field3"
;"X","A","X"
;"B","X","C"
;"D","X","X"
;"X","E","F"
;"Z","Z","Z"}

...uses a Criteria in cells E1:E2 in which E2
contains the formula, =OR(A2="X",B2="X",C2="X"),
and beginning on Sheet2!A1 produces...

{"Field1","Field2","Field3"
;"X","A","X"
;"B","X","C"
;"D","X","X"
;"X","E","F"}

Re: Joe, why don't you...Mark;

I need to add flaged data to a list of previously selected data. The X is the flag in Column "A" that triggers which rows from "B:G" gets added to the other page. The loop below works in Debug stepping but over-copies every selection to A1 and I can't for my life figure why?
I have tried all three filters each has a drawback or I haven't figured out how to get around the limitations?
For the AdvancedFilter the copy destination always over copies existing data or the criteria fails to return the whole row from B:G?
Both the data list and the list on the other page will change size, so everything needs to be dynamic? JSW

Re: Same problem different code?

Joe

It looks to me as though your code is not selecting the next cell in the CopyTo area. Try this:

Sub Priority()
Worksheets("Want_Full").Select
For Each r In Worksheets("Want_Full").UsedRange.Rows
n = r.Row
If Worksheets("Want_Full").Cells(n, 1) = "X" Then
Worksheets("Want_Full").Range(Cells(n, 1), Cells(n, 7)).Copy Destination:=Worksheets("Want_Now").Range("A65536").End(xlUp).Offset(1, 0)
Else
End If
Next r
If Worksheets("Want_Now").Range("A1") = "" Then Worksheets("Want_Now").Rows(1).Delete shift:=xlShiftUp
End Sub

This procedure leaves Row1 in the copy to sheet blank, that's why I have included the delete line. You can leave it out if you wish.

Does this help?

Regards

Sub Priority()

Re: Joe, why don't you...Mark;

> For the AdvancedFilter the copy destination
> always over copies existing data...

Not necessarily. The "CopyToRange" determines
the destination. Your VBA code can easily change
this specfication.

> ...or the criteria fails to return the whole
> row from B:G?

The Criteria is responsible for the selection of
rows -- not columns. A defined name range,
"Extract", is created by Advanced AutoFilter. It's
the field names in this cell range that detemine
which columns are extracted. The extent of the
Extract range and the column names within can be
easily manipulated with VBA. I need to add flaged data to a list of previously selected data. The X is the flag in Column "A" that triggers which rows from "B:G" gets added to the other page. The loop below works in Debug stepping but over-copies every selection to A1 and I can't for my life figure why?

Robb, Worked well with only a minor change

Thanks, Robb.
This is the changes, I also will add additional code to do more, but you core changes worked well, Thank You. JSW

Sub Priority()
'Find all the rows ("A:G") that have a "X" in column "A" copy
'that row to the next blank row on a different sheet.
Worksheets("Want_Full").Select
For Each r In Worksheets("Want_Full").UsedRange.Rows
n = r.Row
If Worksheets("Want_Full").Cells(n, 1) = "X" Then
Worksheets("Want_Full").Range(Cells(n, 1), Cells(n, 7)).Copy Destination:=Worksheets("Want_Now").Range("A65536").End(xlUp).Offset(1, 0)
If Worksheets("Want_Now").Cells(n, 1) <> "X" Then Worksheets("Want_Now").Rows(n).Delete 'shift:=xlShiftUp
Else
End If
Next r
End Sub Joe It looks to me as though your code is not selecting the next cell in the CopyTo area. Try this: Sub Priority()