'плагин написал Казимир Збигнев сохранение отчета

Sub сохранить_лист()
    Dim awb As Workbook, sh As Worksheet, sFilename$
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = False
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If awb Is Nothing Then
            sh.Copy
            Set awb = ActiveWorkbook
        Else
            sh.Copy After:=awb.Sheets(awb.Sheets.Count)
        End If
    Next
    sFilename = Replace(ThisWorkbook.FullName, "Портянка", "отчет порт от " & Format(Date, "dd mmmm yyyy"))
    Mid(sFilename, Len(sFilename), 1) = "x"
    awb.SaveAs sFilename, xlOpenXMLWorkbook
    awb.Close False
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = True
    Application.ScreenUpdating = True
End Sub