Private Sub CommandButton1_Click()
 Dim tblRange As Excel.Range
 Dim WordApp As Word.Application
 Dim WordDoc As Word.Document
 Dim WordTable As Word.Table
 Set tblRange = ThisWorkbook.Worksheets("Sheet1").Range("K8:Q23")
 On Error Resume Next
    Set WordApp = GetObject(class:="Word.Application")
    If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
    WordApp.Visible = True
    WordApp.Activate
    Set WordDoc = WordApp.Documents.Add
    tblRange.Copy
WordDoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
Set WordTable = WordDoc.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)
End Sub

Sub RangeColorY()
With Selection
Range(.Item(1), _
.Item(1)).Interior.ColorIndex = 6
End With
End Sub

Sub RangeColor()
Dim Rng As Range
    Set Rng = Application.InputBox("A9", "A9", Type:=8)
    Rng.Interior.ColorIndex = 5
End Sub

Sub SozdatFajl()
Sheets("Заказ").Range("J1:R45").Copy
Workbooks.Add
ActiveSheet.Paste Destination:=Range("A1")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:="C:\Users\TsarakovRCh\Documents\Тестирование\Деффектная ведомость"
Application.DisplayAlerts = True
End Sub