Conditional copy paste in VBA

[MarcMaerien]

Hi,

I want to copy below data from sheet1 to sheet2, but only when column C AND D contain a value. If these are empty I don't want to copy paste that row.
[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[/TR]
[TR]
[TD]1/2/2019[/TD]
[TD]Natie[/TD]
[TD]1000[/TD]
[TD]200[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/2/2019[/TD]
[TD]Discharge[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/2/2019[/TD]
[TD]Load[/TD]
[TD]1500[/TD]
[TD]100
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/2/2019[/TD]
[TD]VPC[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/2/2019[/TD]
[TD]RFT[/TD]
[TD]2000[/TD]
[TD]500[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

As the data on sheet1 is different on a daily bases, I want the data to paste on the next empty row in sheet2

Thanks for the help

 

[alansidman]

Option Explicit


Sub MarcM()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim lr As Long, lr2 As Long, i As Long
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 1 To lr
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        If s1.Range("C" & i) <> "" And s1.Range("D" & i) <> "" Then
            s1.Range("A" & i).EntireRow.Copy
            s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Completed"
End Sub