VBA Code to be completed with actual date

[caos88]

Good Afternoon,

i currently have the below code to cut and paste rows from Sheet 1 to final sheet. However, i was wondering if, together with this operation, is possible to include the date when the row will actually be moved to the final sheet. Code has been given from you guys....in another threads.
Any idea about it ?

Thank you


Sub Cut()

Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet


' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Final_sheet")

j = Target.Range("A" & Rows.Count).End(xlUp).Row + 1 ' Start copying 1 down from the last row on sheet
For Each c In Source.Range("I1:I1000") ' Do 1000 rows
If c = "Proceed" Then
Source.Rows(c.Row).Copy Target.Rows(j)
Source.Rows(c.Row).Cut Target.Rows(j)
j = j + 1

End If
Next c
End Sub

 

[sericom]

This will place the date in column "M" on the Target sheet

Sub Cut()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
        
    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Final_sheet")
    
    j = Target.Range("A" & Rows.Count).End(xlUp).Row + 1 ' Start copying 1 down from the last row on sheet
    For Each c In Source.Range("I1:I1000") ' Do 1000 rows
        If c = "Proceed" Then
            'Source.Rows(c.Row).Copy Target.Rows(j)
            Source.Rows(c.Row).Cut Target.Rows(j)
            Target.Range("M" & j).Value = Date
            j = j + 1
        End If
    Next c
End Sub

 

[caos88]

This will place the date in column "M" on the Target sheet

Sub Cut()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
       
    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Final_sheet")
   
    j = Target.Range("A" & Rows.Count).End(xlUp).Row + 1 ' Start copying 1 down from the last row on sheet
    For Each c In Source.Range("I1:I1000") ' Do 1000 rows
        If c = "Proceed" Then
            'Source.Rows(c.Row).Copy Target.Rows(j)
            Source.Rows(c.Row).Cut Target.Rows(j)
            Target.Range("M" & j).Value = Date
            j = j + 1
        End If
    Next c
End Sub

Hello @sericom . That works perfectly !!! thank you