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