Copy / Paste Macro only for rows where data exists in a given range

[mikestorm]

Hi all, first off thank you in advance for reading and considering to help. I am looking for assistance on a copy paste macro to copy data to a new sheet called 'Export' (destination tab already exists) but to only copy rows where data exists in columns E through N.

Below is a visual representation of what I mean. Source tab, not all rows will have data populated.

After the macro fires, Export tab would look like this. It's important to note on the source tab there are data in columns to the right of Column N (Criteria 8) but only through column N in the row should be copied.

That's essentially it. Any guidance would be very much appreciated!

 

[rpaulson]

try this on a copy of your file:

Sub Do_it()

Dim rs As Worksheet
Set rs = Worksheets("Export")

lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = 4 To lr
If WorksheetFunction.CountA(Range(Cells(r, "E"), Cells(r, "N"))) > 0 Then

rr = rs.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & r & ":N" & r).Copy rs.Range("A" & r & ":N" & r)

End If
Next

End Sub

Hth,
-Ross

 

[mikestorm]

try this on a copy of your file:

Sub Do_it()

Dim rs As Worksheet
Set rs = Worksheets("Export")

lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = 4 To lr
If WorksheetFunction.CountA(Range(Cells(r, "E"), Cells(r, "N"))) > 0 Then

rr = rs.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & r & ":N" & r).Copy rs.Range("A" & r & ":N" & r)

End If
Next

End Sub

Hth,
-Ross

Hi Rob, thank you. This does move the pertinent records to the export tab, but it preserves the relative spacing of the rows with data, as well as the formatting (I tweaked your code to grab the header also on row 3).

Was hoping data could be written in an unformatted way starting on A1 without row spaces like the output of my OP:

 

[rpaulson]

oops

Range("A" & r & ":N" & r).Copy rs.Range("A" & r & ":N" & r)

should be

Range("A" & r & ":N" & r).Copy rs.Range("A" & rr & ":N" & rr)

 

[mikestorm]

Thank you! I tweaked it slightly as it was pasting formats/formulas and also not on row 1 of "Export" but you definitely got me there!

Sub Do_it()

Dim rs As Worksheet
Set rs = Worksheets("Export")

lr = Cells(Rows.Count, "A").End(xlUp).Row
For r =3 To lr
If WorksheetFunction.CountA(Range(Cells(r, "E"), Cells(r, "N"))) > 0 Then

rr = rs.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & r & ":N" & r).Copy
rs.Range("A" & rr - 1 & ":N" & rr).PasteSpecial Paste:=xlPasteValues


End If
Next

End Sub