Copy and paste rows from one wksht to another based on cell value

[PVANS]

Good morning

Was wondering if someone had a suggestion for me with regards to this, I
have the following code that is copying rows from Worksheet1 ("Working") and
adding them to another worksheet in the same workbook called "March":

Set SrcSht = Sheets("Working")
Set DstSht = Sheets("MARCH")
LastrowA = SrcSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row
LastrowB = DstSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
SrcSht.Range("A1:A" & LastrowA).EntireRow.Copy DstSht.Cells(LastrowB, 1)

I would like to now copy only specific rows based on their value in column Q
and add them to another worksheet in the workbook. I edited the code as
follows, however, it does not seem to work:

Dim LastrowA As Long
Dim LastrowB As Long
Set SrcSht = Sheets("Working")
Set DstSht = Sheets("Sheet3")
LastrowA = SrcSht.Cells(Cells.Rows.Count, "Q").End(xlUp).Row
LastrowB = DstSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1

For q = SrcSht.Range("q65536").End(xlUp).Row To 1 Step -1
If SrcSht.Cells(q, 17) = "cw" Then
SrcSht.Rows(q).Copy DstSht.Cells(LastrowB, 1)
End If
Next

It seems to simply copy the necessary rows onto the same line, thus leaving
me with only one line on Worksheet3. Can someone suggest why this is
happening, and a method to fix it?

Thank you so much

(This is a replica poste as my other one seemed - for completley unknown
reasons - to be in Excel Database programming. apologies for the double
entry, and once again thanks for any help)

 

[Mike H]

Hi,

maybe this

Sub marine()
Dim CopyRange As Range
Dim LastrowA As Long
Dim LastrowB As Long
Set srcsht = Sheets("Working")
Set dstsht = Sheets("Sheet3")
LastrowA = srcsht.Cells(Cells.Rows.Count, "Q").End(xlUp).Row
LastrowB = dstsht.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
Set myrange = srcsht.Range("Q1:Q" & LastrowA)

For Each q In myrange
If InStr(1, q.Value, "cw", vbTextCompare) > 0 Then
If CopyRange Is Nothing Then
Set CopyRange = q.EntireRow
Else
Set CopyRange = Union(CopyRange, q.EntireRow)
End If
End If
Next

If Not CopyRange Is Nothing Then
CopyRange.Copy dstsht.Range("A" & LastrowB)
End If
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[PVANS]

Hi Mike,

Thank you so much. Works brilliantly. Really appreciate your constant help
to me on this website, it is awesome

Cheers
Paul

 

[Mike H]

I'm glad to have helped
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.