Help with copying selected row to new sheet

[ATOMICLUIS]

With the code below I have the following problem. Please help

If the source sheet contains data on B2:B5, and "X"s on A2:A5.
Data on B2:B5 should get copied since they all have an "X" on column A.

But after running the macro only the data from B5 get copied.

Now, If I also include data on C2:C5, then everything get copied.

thanks.

This is what i am using:

Sub Priority()
Application.ScreenUpdating = False
Worksheets("Sheet2").Select
For Each r In Worksheets("Sheet2").UsedRange.Rows
n = r.Row
If Worksheets("Sheet2").Cells(n, 1) = "X" Then
Worksheets("Sheet2").Range(Cells(n, 2), Cells(n, 7)).Copy _
Destination:=Worksheets("Sheet1").Range("B65536").End(xlUp).Offset(1,
-1)
Else
End If
Next r

Worksheets("Sheet2").Columns("A").Replace What:="X", Replacement:="*",
_
SearchOrder:=xlByColumns, MatchCase:=True

Application.CutCopyMode = True
Application.ScreenUpdating = True

End Sub

 

[Guest]

Point 1:
It's not that the other values arn't getting copied over, it's that they get
pasted over top of each other. The expression:

Worksheets("Sheet1").Range("B65536").End(xlUp)

doesn't increment if nothing gets pasted to column B (Sheet1) which is the
case if there's nothing in column C (Sheet2) since the code pastes values
from column C (Sheet2) to Column B (Sheet1).

Point 2:
I prefer not to copy and paste if only values are being transfered. I
rewrote the code excluding the copy and paste routine. Minimal testing and
done in a hurry:-

Sub Priority()
Dim rng As Range, c As Range
Dim i As Long
Dim ws As Worksheet, ws2 As Worksheet

Set ws = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
With Application
Set rng = .Intersect(ws2.UsedRange, ws2.Columns(1))
i = 2
.ScreenUpdating = False
For Each c In rng.Cells
If c.Value = "X" Then
c.Value = "*"
ws.Cells(i, 1).Resize(1, 6).Value = c(1, 2).Resize(1, 6).Value
i = i + 1
End If
Next
.ScreenUpdating = True
End With
End Sub

Regards,
Greg