Sub Get_1CData()
Const iPath1C$ = "D:\Данные1С.xlsx" 'путь к файлу с исходными данными
Dim wb1C As Workbook
Dim arr1C(), arr()
Dim I&
Application.ScreenUpdating = False
On Error Resume Next
Set wb1C = Workbooks.Open(iPath1C)
If Not wb1C Is Nothing Then
    With wb1C.Worksheets(1)
        arr1C = .Range(.Cells(13, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, .Cells(13, .Columns.Count).End(xlToLeft).Column)).Value
        wb1C.Close False
    End With
Else
    MsgBox "По указанному пути файл с исходными данными отсутствует!", vbCritical + vbOKOnly
    Exit Sub
End If
If UBound(arr1C, 1) <> 0 Then
    ReDim arr(LBound(arr1C, 1) To UBound(arr1C, 1), 1 To 8)
Else
    MsgBox "В исходном файле нет данных или структура файла изменена!", vbCritical + vbOKOnly
    Exit Sub
End If
For I = LBound(arr1C, 1) To UBound(arr1C, 1)
    arr(I, 1) = arr1C(I, 1)
    arr(I, 2) = arr1C(I, 3)
    arr(I, 3) = arr1C(I, 5)
    arr(I, 4) = arr1C(I, 6)
    arr(I, 5) = arr1C(I, 7)
    arr(I, 6) = arr1C(I, 8)
    arr(I, 7) = arr1C(I, 9)
    arr(I, 8) = arr1C(I, 10)
Next
With ThisWorkbook.Worksheets("SMT")
    Call ResetTable 'очищаем шаблон
    .ListObjects("tblShablon").DataBodyRange(1, 1).Resize(UBound(arr, 1), 8) = arr
End With
Application.ScreenUpdating = True
End Sub

Sub ResetTable()
Dim tbl As ListObject
Set tbl = ThisWorkbook.Worksheets("SMT").ListObjects("tblShablon")
  With tbl.DataBodyRange
    If .Rows.Count > 1 Then
      .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
    End If
  End With
  tbl.DataBodyRange.Rows(1).ClearContents
End Sub

Sub SavePrice()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook
    .Worksheets("Price").Copy
    ActiveWorkbook.SaveAs Filename:=.Path & Application.PathSeparator & "Прайс.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End With
Application.ScreenUpdating = True
End Sub