[ivanhoe75]

Вот дописал до такого состояния
запись не работает. спотыкается на FileFormat все перепробовал - не проходит

Dim objShape As Word.InlineShape
Dim objOLE As Word.OLEFormat

Dim objWorkbook As Object 'Рабочая книга Excel
Dim objWorksheet As Object 'Рабочий лист
Dim objDiapazon As Object 'Диапазон ячеек

For Each objShape In ActiveDocument.InlineShapes
Set objOLE = objShape.OLEFormat

If Not objOLE Is Nothing Then
If objOLE.ProgID Like "Excel.Sheet*" Then
objOLE.Activate

Set objWorkbook = objOLE.Object
'Set objWorksheet = objWorkbook.Worksheets(1)
Set objWorksheet = objWorkbook.Worksheets("Лист1")
Set objDiapazon = objWorksheet.Range("A1:J15")

Exit For
End If
End If
' копирование таблицы в новый документ
'Dim wb As Workbook
Dim wb As Object
Dim ActiveSheet As Object
Application.ScreenUpdating = False
ActiveSheet = objWorkbook
ActiveSheet.Range ("A1:J15")
ActiveSheet.Select
ActiveSheet.Copy
'ActiveSheet.UsedRange.Copy
'xlExcel9795 xlNormal xlCSV xlXMLSpreadsheet
objWorkbook.SaveAs FileName:= _
"\\cad\...\userdata\...\Рабочий стол\sklad.csv", FileFormat:= _
xlXMLSpreadsheet, CreateBackup:=False, Local:=True
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb.ActiveSheet.Cells(1, 1)
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With