If "On PTO", Column AF any cell 23 thru 35 = True, copy Cell A23 and Cell AC23 and paste to Sheet "<1 YR Not PTO", Cell A5 and Cell B5 if empty otherwise next empty row. I then want to clear content on Sheet "On PTO" in Cells A:Z of the row that held True, but keep formulas in place for new entries.
Sheet6="On PTO" has Name in (A23-A35), Date in (AC23-35), True/False in (AF23-35)
Sheet8="<1 YR Not PTO" (A5-A30) Name, (B5-B30) Date, A5+6 thru A29+30 are merged. Same for Column B.
Here is what I’m working with but can’t figure out where I’m going wrong. Data already on sheet "<1YR Not PTO" is being overwritten and I need that data to stay. As for the clear contents I'm receiving a run error. Hope someone can help.
Sub MyCopyPasteClear()
Dim lastRow As Long
Dim myRow As Long
Dim myCopyRow As Long
myCopyRow = 5
lastRow = Sheets("On PTO").Cells(Rows.Count, "AF").End(xlUp).Row
Application.ScreenUpdating = False
For myRow = 23 To 35
If Sheets("On PTO").Cells(myRow, "AF") = "True" Then
Sheets("<1 YR Not PTO").Cells(myCopyRow, "A") = Sheets("On PTO").Cells(myRow, "A")
Sheets("<1 YR Not PTO").Cells(myCopyRow, "B") = Sheets("On PTO").Cells(myRow, "AC")
lastRow = Sheets("<1 YR Not PTO").Cells(Rows.Count, 1).End(xlDown).Row
myCopyRow = myCopyRow + 2
Sheets("On PTO").Cells(myRow, "A:Z").ClearContents
End If
Next myRow
Application.ScreenUpdating = True
End Sub
Sheet6="On PTO" has Name in (A23-A35), Date in (AC23-35), True/False in (AF23-35)
Sheet8="<1 YR Not PTO" (A5-A30) Name, (B5-B30) Date, A5+6 thru A29+30 are merged. Same for Column B.
Sub MyCopyPasteClear()
Dim lastRow As Long
Dim myRow As Long
Dim myCopyRow As Long
myCopyRow = 5
lastRow = Sheets("On PTO").Cells(Rows.Count, "AF").End(xlUp).Row
Application.ScreenUpdating = False
For myRow = 23 To 35
If Sheets("On PTO").Cells(myRow, "AF") = "True" Then
Sheets("<1 YR Not PTO").Cells(myCopyRow, "A") = Sheets("On PTO").Cells(myRow, "A")
Sheets("<1 YR Not PTO").Cells(myCopyRow, "B") = Sheets("On PTO").Cells(myRow, "AC")
lastRow = Sheets("<1 YR Not PTO").Cells(Rows.Count, 1).End(xlDown).Row
myCopyRow = myCopyRow + 2
Sheets("On PTO").Cells(myRow, "A:Z").ClearContents
End If
Next myRow
Application.ScreenUpdating = True
End Sub