Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub 'выделено больше одной ячейки
If Not Intersect(Target, Range("E9:P24")) Is Nothing Then
    Dim iMonth As String
    Dim i As Integer
    Dim iLastRow As Integer
    Dim iLastRowГрафик As Integer
      iMonth = Cells(8, Target.Column)
       iLastRowГрафик = Cells(Rows.Count, 4).End(xlUp).Row + 1
  With Sheets(iMonth)
    iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    If iLastRow > 5 Then
       .Range(.Cells(5, 1), .Cells(iLastRow, 5)).ClearContents
    End If
    For i = 9 To iLastRowГрафик
      If Not IsEmpty(Cells(i, 5)) Then
        iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        If iLastRow = 5 Then
            .Cells(5, 1) = 1
        Else
            .Cells(iLastRow, 1) = .Cells(iLastRow - 1, 1) + 1
        End If
          .Cells(iLastRow, 2) = Cells(i, 5)
          .Cells(iLastRow, 3) = Cells(i, 4)
          .Cells(iLastRow, 4) = "Иванов И.И."
      End If
    Next
  End With
End If
End Sub

Private Sub CommandButton1_Click()
Sheets("Шаблон").Select
' Присваиваем значения нашим ячейкам, по именам которые мы задавали

Range("oborudov").Value = TextBox1.Value

' Копируем все
Cells.Select
Selection.Copy
' Создаем новую книгу или делаем ее активной
If NewBook = "" Then
Workbooks.Add
NewBook = ActiveWorkbook.Name
Else
Workbooks(NewBook).Activate
Cells(1, 1).Select
End If
' Вставляем данные в эту книгу
Application.DisplayAlerts = False
ActiveSheet.Paste
Application.CutCopyMode = False

On Error Resume Next
' название подпапки, в которую по-умолчанию будет предложено сохранить файл
Const REPORTS_FOLDER = "Отчёты\"
' создаём папку для файла, если её ещё нет
MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
' выбираем стартовую папку
ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER

' вывод диалогового окна для запроса имени сохраняемого файла
Filename = Application.GetSaveAsFilename("отчёт.xls", "Отчёты Excel (*.xls),", , _
"Введите имя файла для сохраняемого отчёта", "Сохранить")
' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
If VarType(Filename) = vbBoolean Then Exit Sub

' копируем активный лист (при этом создаётся новая книга)
Err.Clear: ActiveSheet.Copy: DoEvents
If Err Then Exit Sub ' произошла какая-то ошибка при попытке копирования листа

' убеждаемся, что активной книгой является копия листа
If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
' сохраняем файл под заданным именем в формате Excel 2003
ActiveWorkbook.SaveAs Filename, xlWorkbookNormal

' закрываем сохранённый файл
' (удалить следующую строку, если закрывать созданный файл не требуется)
ActiveWorkbook.Close False
End If
ActiveWorkbook.Close False 'закрываем скопированный лист
UserForm1.Hide ' закрытие формы
Sheets("Данные").Select ' переход обратно к листу с кнопкой
MsgBox "Создание акта выполнено успешно"
End Sub