Macro needs editing

[tsakta13ole]

Hi. The below macro copies cells from columns R,S,T to another sheet. It deletes the last row of data. How can I change it so that it does not include the last row of data only if cell R6 in sheet "events exp up to 2 months" is an even number? For example, if R6=57 then clear

Z = Sheets("P_L events up to 2 months").Range("B" & Rows.Count).End(3).Row
        Sheets("P_L events up to 2 months").Range(Cells(Z, "B"), Cells(Z, "D")).Clear

If R6=56 don't clear.

Sub copy_paste1()
    Dim i As Long, Y As Long, Z As Long
    With Application
        .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False
    End With
        Sheets("P_L events up to 2 months").Select
        Range("B4:D20000").ClearContents
    
        Y = Sheets("events exp up to 2 months").Range("T" & Rows.Count).End(3).Row
        For i = 9 To Y
            With Sheets("P_L events up to 2 months")
                .Range("B" & Rows.Count).End(3)(2).Value = Sheets("events exp up to 2 months").Range("R" & i).Value
                .Range("C" & Rows.Count).End(3)(2).Value = Sheets("events exp up to 2 months").Range("S" & i).Value
                .Range("D" & Rows.Count).End(3)(2).Value = Sheets("events exp up to 2 months").Range("T" & i).Value
            End With
        Next i
        Z = Sheets("P_L events up to 2 months").Range("B" & Rows.Count).End(3).Row
        Sheets("P_L events up to 2 months").Range(Cells(Z, "B"), Cells(Z, "D")).Clear
    With Application
        .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True
    End With
End Sub

Thanks for any help!

[NeedForExcel]

Try this (Untested Code)

Sub copy_paste1()
    Dim i As Long, Y As Long, Z As Long
    With Application
        .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False
    End With
        Sheets("P_L events up to 2 months").Select
        Range("B4:D20000").ClearContents
    
        Y = Sheets("events exp up to 2 months").Range("T" & Rows.Count).End(3).Row
        For i = 9 To Y
            With Sheets("P_L events up to 2 months")
                .Range("B" & Rows.Count).End(3)(2).Value = Sheets("events exp up to 2 months").Range("R" & i).Value
                .Range("C" & Rows.Count).End(3)(2).Value = Sheets("events exp up to 2 months").Range("S" & i).Value
                .Range("D" & Rows.Count).Eznd(3)(2).Value = Sheets("events exp up to 2 months").Range("T" & i).Value
            End With
        Next i
        Z = Sheets("P_L events up to 2 months").Range("B" & Rows.Count).End(3).Row
        If Application.WorksheetFunction.IsOdd(Worksheets("events exp up to 2 months").Range("R6").Value) Then Sheets("P_L events up to 2 months").Range(Cells(Z, "B"), Cells(Z, "D")).Clear
    With Application
        .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True
    End With
End Sub

Let me know if you have any issues.

[tsakta13ole]

Thanks! This works!

[NeedForExcel]

Glad it helps..

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.