transfer data from the main workbook to another sheet Based on the date of retirement age

[Feisty2]

Greetings,
Appreciate any direction or code you might share.
Thanks a lot for your help.

[alansidman]

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

[Feisty2]

I'm new here and do not know how I can upload a file

[Feisty2]

All help is much appreciated.

[Feisty2]

All help is much appreciated.

[Feisty2]

Any help in this topic please?

[Feisty2]

Can someone assist or can give some direction? Thank you

[jindon]

Merged cells....

Sub test()
    Sheets("result").Cells.Delete
    With Sheets("main")
        .Rows("1:2").Copy Sheets("result").Cells(1)
        .[z2].Formula = "=and(c2>=eomonth(today(),1)+1-day(today()),c2<=eomonth(today(),1))"
        With .Range("a1", .Cells.SpecialCells(11))
            .Rows("1:2").Copy Sheets("result").Cells(1)
            .AdvancedFilter 1, .Parent.[z1:z2]
            .Offset(2).Copy Sheets("result").[a3]
        End With
        If .FilterMode Then .ShowAllData
        .[z2].Clear
    End With
    With Sheets("result")
        .[z2].Clear: .Columns.AutoFit
    End With
End Sub

[Feisty2]

Thanks a lot Mr. jindon .. That's wonderful
Best and kind regards

[jindon]

1) It is working if I change system date to Mar. All April data are transferred.
2) If you want to delete, add one line

        With .Range("a1", .Cells.SpecialCells(11))
            .Rows("1:2").Copy Sheets("result").Cells(1)
            .AdvancedFilter 1, .Parent.[z1:z2]
            .Offset(2).Copy Sheets("result").[a3]
            .Offset(2).EntireRow.Delete  '<---- this line
        End With

[Feisty2]

Thanks a lot Mr. jindon for your great efforts

Best Regards

[jindon]

OK, I see...
Change

        .[z2].Formula = "=and(c2>=eomonth(today(),1)+1-day(today()),c2<=eomonth(today(),1))

to

        .[z2].Formula = "=and(c2>=eomonth(today(),1)-day(eomonth(today(),1))+1,c2<=eomonth(today(),1))"

[Feisty2]

That's wonderful .. I am so grateful for you Mr. jindon

All the best,

[jindon]

1) Change the formula to

.[z2].Formula = "=or(istext(c2),and(c2>=eomonth(today(),1)-day(eomonth(today(),1))+1,c2<=eomonth(today(),1)))"

2) If you want to sort the result then insert one line

    With Sheets("result")
        .[z2].Clear: .Columns.AutoFit
        .Range("a3", .Cells.SpecialCells(11)).Sort .Range("c3")  '<--- this line
    End With

[Feisty2]

That's Amazing and wonderful Mr. jindon and Thank you very very much for your interest in the issue
The question now is How can replace the date in column C to word "He finished his service"
I wish you all the best .. Best Regards

[jindon]

Change to

Sub test()
    Application.ScreenUpdating = 0
    On Error Resume Next
    Sheets("Result").Cells.Delete
    With Sheets("main")
        .Rows("1:2").Copy Sheets("result").Cells(1)
        .[z2].Formula = "=or(istext(c2),and(c2>=eomonth(today(),1)-day(eomonth(today(),1))+1,c2<=eomonth(today(),1)))"
        With .Range("a1", .Cells.SpecialCells(11))
            .Rows("1:2").Copy Sheets("result").Cells(1)
            .AdvancedFilter 1, .Parent.[z1:z2]
            .Offset(2).Copy Sheets("result").[a3]
            .Offset(2).EntireRow.Delete
        End With
        If .FilterMode Then .ShowAllData
        .[z2].Clear
    End With
    With Sheets("result")
        .[z2].Clear
        .Range("a3", .Cells.SpecialCells(11)).Sort .Range("c3")
        On Error Resume Next
        .Columns(3).SpecialCells(2, 1).Value = "He finished his service"
        .Columns.AutoFit
        .Activate
    End With
    Application.ScreenUpdating = 1
  End Sub

[Feisty2]

Thank you very much Mr. jindon for this perfect solution

All the best, Best and kind regards

[jindon]

Is this the last one?

If not you, should state what you really want in one question since I don't want to do one by one.

[Feisty2]

Thank you very much Mr. jindon for your reply
Yes, this is the last question To complete Thread
All the best, Best and kind regards

[jindon]

Try change to

Sub test()
    Dim LastR As Range
    Application.ScreenUpdating = 0
    Sheets("Result").Cells.Delete
    With Sheets("main")
        .Cells(1).CurrentRegion.Rows("1:2").Copy Sheets("result").Cells(1)
        If Not [isref('archives'!a1)] Then
            Sheets.Add(after:=Sheets("result")).Name = "archives"
            .Cells(1).CurrentRegion.Rows("1:2").Copy Sheets("archives").Cells(1)
            Set LastR = Sheets("archives").[a3]
        End If
        .[z2].Formula = "=or(istext(c2),and(c2>=eomonth(today(),1)-" & _
                        "day(eomonth(today(),1))+1,c2<=eomonth(today(),1)))"
        With .Range("a1", .Cells.SpecialCells(11))
            .AdvancedFilter 1, .Parent.[z1:z2]
            .Offset(2).Copy Sheets("result").[a3]
            .Offset(2).EntireRow.Delete
        End With
        If .FilterMode Then .ShowAllData
        .[z2].Clear
    End With
    With Sheets("result")
        .Range("a3", .Cells.SpecialCells(11)).Sort .Range("c3")
        On Error Resume Next
        .Columns(3).SpecialCells(2, 1).Value = "He finished his service"
        On Error GoTo 0
        .Columns.AutoFit
        .Activate
        If Application.CountA(.Columns(1)) = 1 Then Exit Sub
        If LastR Is Nothing Then Set LastR = Sheets("archives").Range("a" & Rows.Count).End(xlUp)(2)
        .Range("a3", .Cells.SpecialCells(11)).Copy LastR
        LastR.Parent.Columns.AutoFit
    End With
    Application.ScreenUpdating = 1
End Sub

[Feisty2]

Thanks a lot Mr. jindon for your great support all the time

Best and kind regards
Feisty