Привет всем! Помогите пожалуйста написать макрос!
Макрос должен брать таблицу из Word и вставлять ее в Excel, причем в документе Word несколько таблиц, нужную таблицу следует выбирать, например, по имени столбца.
Заранее спасибо!

Макрос в Excel.
Вот он собственно:
Sub Поиск()
Dim n, m, l, tb As Long
Dim Path As String

Path = GetFolderPath

Set wa = CreateObject("Word.Application")
On Error GoTo 3
Set oCurrDoc = wa.Documents.Open(Path)

wa.Visible = True



l = oCurrDoc.Tables.Count

For n = 1 To l

If oCurrDoc.Tables(n).Range.Rows(1).Cells(2).Range.Text Like "Наименование дисциплин*" _
And oCurrDoc.Tables(n).Range.Rows(1).Cells(1).Range.Text Like "Индекс*" Then

tb = n

Exit For
End If

Next


n = oCurrDoc.Tables(tb).Range.Rows.Count
m = oCurrDoc.Tables(tb).Range.Columns.Count

ReDim Rng(1 To n, 1 To m)

For n = 1 To oCurrDoc.Tables(tb).Range.Rows.Count
For m = 1 To oCurrDoc.Tables(tb).Range.Columns.Count



On Error Resume Next
Dim ssl As String
ssl = Replace(oCurrDoc.Tables(tb).Range.Rows(n).Cells(m).Range.Text, Chr(13), "")

ssl = Replace(ssl, Chr(7), "")

Rng(n, m) = ssl



Next


Next

Application.ScreenUpdating = False

ActiveSheet.Range(Cells(1, 1), Cells(n - 1, m - 1)) = Rng

ActiveSheet.Range("a1").ColumnWidth = 18
ActiveSheet.Range("b1").ColumnWidth = 100
ActiveSheet.Range("c1").ColumnWidth = 18
ActiveSheet.Columns("A:C").WrapText = True



ActiveSheet.Range(Cells(1, 1), Cells(n - 1, m - 1)).Borders(1).LineStyle = 1
ActiveSheet.Range(Cells(1, 1), Cells(n - 1, m - 1)).Borders(2).LineStyle = 1
ActiveSheet.Range(Cells(1, 1), Cells(n - 1, m - 1)).Borders(3).LineStyle = 1
ActiveSheet.Range(Cells(1, 1), Cells(n - 1, m - 1)).Borders(4).LineStyle = 1


Application.ScreenUpdating = True

3
wa.Quit
End Sub
Function GetFolderPath(Optional ByVal Title As String = "Выберите файл", Optional ByVal InitialPath As String) As String
GetFolderPath = "": PS = Application.PathSeparator
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
If .Show = -1 Then GetFolderPath = .SelectedItems(1): If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath
End With
End Function


Проблема в том, что при большом объеме данных в строке таблицы Word, макрос не работает.

В принципе если кому-то проще написать новый макрос чем разбираться в чужом, то я только за=)))

Да, конечно!

Ну вот и вас работает!=)))
А почему у меня не работает?!!!
Он не добавляет мне строки после строки ГСЭ.Ф.00 Федеральный компонент 1262.
В чем может быть проблема, не подскажите?

Если в этой таблице я уменьшаю ячейки, оставляя только пару строк, то все работает!
Вот я и подумала что это как0то от объма зависит!=)

Уменьшаю текст в ячейках.
Молча прекращает работать, никаких ошибок не выдает.
Он даже рисует рамки ячеек, но текста в них нет!

А у вас какая версия excel? если не секрет.

а у меня 2003.
строку убрала, но ошибок все равно нек выдает.
да и в цикле все строчки пробегает.

Спасибо за идею, переделала!
А вот с последней строчкой действительно проблематично

Ясненько!
Попробую сделать по хорошему!
Спасибо огромное за помощь!!!