Loopy about my loop

[keithkemble]

I posted this Sat am and am now lost.
Can someone help me with theis routine.
It worked perfectly well. i.e. it scroll line by line to the bottom of the range and copies the selected range to another sheet and pastes incrementally.
Brill !
However I only want it to select the cell with a "c" or "C" in column E.

I cannot get it to select only those rows, Any suggestions.

Thanks :-
Sub cmr()
Dim i
i = 15
' To select condition c or C in column e then place in sheet cmr at A15
Sheets("mobile").Select
Range("e15").Select
For Each X In Range("E15", Range("E16").End(xlDown))
If X = "" Then Exit For
' If ActiveCell.Value <> "c" Then GoTo nextrow
Sheets("mobile").Activate
Range("A" & i).Select
Range("A" & i & ":H" & i).Select
Selection.Copy
Sheets("cmr").Select
Range("A15").Select
Sheets("cmr").Select
Range("A2000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Sheets("mobile").Select
nextrow: i = Selection.Row + 1
' End If
' End If
Next
Sheets("mobile").Select
Range("E15").Select
End Sub

[Barrie Davidson]

Try changing your code to:

Sub cmr()
Dim i
i = 15
' To select condition c or C in column e then place in sheet cmr at A15
Sheets("mobile").Select
Range("e15").Select
For Each X In Range("E15", Range("E16").End(xlDown))
If X = "" Then Exit For
If UCase(ActiveCell.Value) = "C" Then
Sheets("mobile").Activate
Range("A" & i).Select
Range("A" & i & ":H" & i).Select
Selection.Copy
Sheets("cmr").Select
Range("A15").Select
Sheets("cmr").Select
Range("A2000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Sheets("mobile").Select
End If
i = Selection.Row + 1
End If
Next
Sheets("mobile").Select
Range("E15").Select
End Sub

[keithkemble]

Barry, Thanks,
I tried your suggestion but the same thing happened as my previous attemps, That is it only selects the one row and then stops.
kk

[Barrie Davidson]

Oops, try this (slightly modified your code) I think it will work for you.

Sub cmr()
Dim i
Dim LastRow As Long
LastRow = Range("E15").End(xlDown).Row
i = 15
' To select condition c or C in column e then place in sheet cmr at A15
Sheets("mobile").Select
Range("e15").Select
Do Until i > LastRow
If ActiveCell.Value = "" Then Exit Do
If UCase(ActiveCell.Value) = "C" Then
Sheets("mobile").Activate
Range("A" & i).Select
Range("A" & i & ":H" & i).Select
Selection.Copy
Sheets("cmr").Select
Range("A15").Select
Sheets("cmr").Select
Range("A2000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Sheets("mobile").Select
End If
i = Selection.Row + 1
End If
Loop
Sheets("mobile").Select
Range("E15").Select
End Sub

[keithkemble]

Thanks Barrie
While you were updating the board I cracked it.

I have used your line UCase etc but added the following after
i = Selection + 1

ElseIf UCase (activecell.value) <> "C" then
i = Selection + 1
Range ("E" & i).select

This forces the active cell to drop one row and then re evaluate.

Thank for you help

Have a look at :-
http://www.mrexcel.com/wwwboard/messages/23190.html