Copy rows from one tab, to start on a specific row in another tab

[Salts]

Trying to copy rows from spreadsheet named "Items", where if Column E = Yes, then those columns will copy over to spreadsheet named "Print or Email This" & paste starting in row 13 column A.
The code below is isn't working for me.

Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Items")
Set Target = ActiveWorkbook.Worksheets("Print or Email This")

j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "yes" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = 13 + 1
End If
Next c
End Sub

 

[Paul Ked]

Only glanced at this but

[COLOR=#333333]j = 13 + 1[/COLOR]

stood out. Try

[COLOR=#333333]j = j + 1[/COLOR]

 

[Salts]

I tried that but it pasted the rows in column A starting in row 1.
I need them to paste starting in row 13.

 

[Paul Ked]

sorry, wrong thread!

 

[Paul Ked]

[COLOR=#333333]j = 1 ' Start copying to row 1 in target sheet[/COLOR]

It's there!

[COLOR=#333333]j = 13 ' Start copying to row 13 in target sheet[/COLOR]

 

[Salts]

Thanks Paul. I was overlooking changing the initial j=1 to 13.
Macro ran fine, however, It copied over then entire row.
my criteria to copy is based off column E in worksheet "Items" & I only need it to copy columns "A:D" - not E & paste this info to the spreadsheet "Print or Email This"

 

[Paul Ked]

Sorry for delay, I had 'real' work to do!

Try

Sub CopyYes()
    Dim i As Long
    Dim j As Integer
    Dim lr As Long
    Dim Source As Worksheet
    Dim Target As Worksheet


    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Items")
    Set Target = ActiveWorkbook.Worksheets("Print or Email This")
    'Get last row
    lr = Source.Cells(Source.Rows.Count, 5).End(3).Row
    j = 13 ' Start copying to row 1 in target sheet
    For i = 1 To lr
        If Source.Cells(i, 5) = "yes" Then
            Source.Range("A" & i & ":D" & i).Copy Target.Range("A" & j)
            j = j + 1
        End If
    Next
End Sub

 

[Paul Ked]

Sub Test()
    Dim rw As Long, i As Long
    rw = 1 '<<<<<Start Row!
    Do Until Cells(rw, 1) = ""
        If Cells(rw, 2) > 1 Then
            For i = 1 To Cells(rw, 2) - 1
                Rows(rw).Copy
                Rows(rw + 1).Insert Shift:=xlDown
                rw = rw + 1
            Next
        End If
        rw = rw + 1
    Loop
End Sub

 

[Salts]

Paul, had "Real Work" to do myself.
Appreciate the help. Looks like I good to go for now.

 

[Paul Ked]