Sub Macro9()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(2)
Dim RG As Range: Set RG = ws.Range("F25")
Dim NM As Range: Set RG = ws.Range("F21")
Dim wb As Workbook
Dim wbs As Worksheet
Set wb = Workbooks.Open(ThisWorkbook.Path & "\file2.xlsm", True, , True, Password:="123")
Set wbs = wb.Sheets(1)
lr = wbs.Range("b" & Rows.Count).End(xlUp).Row + 1
wbs.Range("b" & lr).Value = RG
wbs.Range("a" & lr) = wbs.Range("a" & lr - 1) + 1
wbs.Range("b" & lr).Offset(, 1) = Date
wbs.Range("b" & lr).Offset(, 2) = Time
wbs.Range("b" & lr).Offset(, 3) = Date + Time
lr = wbs.Range("b" & Rows.Count).End(xlUp).Row
ws.Range("F21").Value = wbs.Range("a" & lr).Value
wb.Save
wb.Close
Range("F25").Select
Application.DisplayAlerts = True
Application.CutCopyMode = True
End Sub