Sub Module4()

Dim xlApp As Object
Dim wb As Object
Dim ws As Object

Set xlApp = CreateObject("Excel.Application")
Set ws = ThisWorkbook.Sheets("сцепка")

HomeDir$ = ThisWorkbook.Path
i% = 2 'Начинаем со второй строки
Do
    If ws.Cells(i%, 1).Value = "" Then Exit Do
    If ws.Cells(i%, 1).Value <> "" Then

        s1$ = ws.Cells(i%, 1).text
        s2$ = ws.Cells(i%, 2).text
        s3$ = ws.Cells(i%, 3).text
        s4$ = ws.Cells(i%, 4).text
        s5$ = ws.Cells(i%, 5).text

        FileCopy HomeDir$ & "\Otchet.xlsx", HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx"
        Set wb = xlApp.Workbooks.Open(HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx")

        On Error GoTo ErrorHandler

        ' Введите здесь ваш код
         
        ws.Cells(i%, 1).Value = Now  'Установить дату последнего изменения в столбец A
          
        i% = i% + 1 'Смещение на следующую строку
    End If
Loop

wb.SaveAs Filename:=HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx"
wb.Close
xlApp.Quit

Exit Sub
ErrorHandler:
    wb.Close
    xlApp.Quit
End Sub