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

Salts

New Member
Joined
Aug 21, 2019
Messages
16
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

Active Member
Joined
Jun 4, 2015
Messages
435
Only glanced at this but
Code:
[COLOR=#333333]j = 13 + 1[/COLOR]
stood out. Try
Code:
[COLOR=#333333]j = j + 1[/COLOR]
 

Salts

New Member
Joined
Aug 21, 2019
Messages
16
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

Active Member
Joined
Jun 4, 2015
Messages
435
Code:
[COLOR=#333333]j = 1 ' Start copying to row 1 in target sheet[/COLOR]
It's there!
Code:
[COLOR=#333333]j = 13 ' Start copying to row 13 in target sheet[/COLOR]
 

Salts

New Member
Joined
Aug 21, 2019
Messages
16
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

Active Member
Joined
Jun 4, 2015
Messages
435
Sorry for delay, I had 'real' work to do!

Try

Code:
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

Active Member
Joined
Jun 4, 2015
Messages
435
Code:
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

New Member
Joined
Aug 21, 2019
Messages
16
Paul, had "Real Work" to do myself.
Appreciate the help. Looks like I good to go for now.
 

Forum statistics

Threads
1,078,150
Messages
5,338,528
Members
399,241
Latest member
mominul2241

Some videos you may like

This Week's Hot Topics

Top