Solved: Copy all tables between 2nd heading and 3rd heading

[Ann_BBO]

Hi All,

How to copy all tables between 2nd heading and 3rd heading from word to excel?Now, i have found the 2nd heading by marco and don't know what is the next steps.

Regards,
Ann

[fumei]

Use a Range object for it. Set the range object to be between the two headings.

[Ann_BBO]

Hi fumel and all,

Since i am new user to write the word marco. Would you give me an example to copy the range object between 2 headings. Thanks

Ann

[geekgirlau]

To get you a little further on your way, think about the steps that you need to follow:

• Find the 2nd heading
• Set this as the start of your range
• Find the 3rd heading
• Set this as the end of your range
• Loop through the tables within your range
• For each table, copy ... to where?

[fumei]

You say you have done something already:

"Now, i have found the 2nd heading by marco "

Please post your code.

Essentially though, geekgirlau states it correctly.

You say you have found the second heading. OK. As I stated (and geekgirlau reiterates), use a range object. Set its Start as the end of the found second heading. Now find the third, and set the range object End to the start of that.

Thus, the range object is now the range between them.

[Tinbendr]

It would have been much more polite if you'd posted the original link to this question.

I have the code that finds the range, but not to post into Excel. (I could figure it out, but it would take me a while.) Maybe with your experience with Excel you can finish it.

[GTO]

Hi Tinbendr,

I had tried for a little bit, but wasn't getting anywhere in the Word part and saw your example. I believe/hope(?) I incorporated it true in the Excel part.

Mark

[Tinbendr]

Mark,
I had a look. Very nice!

[Ann_BBO]

Hi ALL,

Thanks for all help. I have solved it by insert the bookmarks in 2nd heading and 3rd heading. Using this method which can copy the all tables between 2nd and 3rd heading. Here is the code:
[VBA]Private Sub CommandButton3_Click()
Dim wdRng As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wdApp.Documents.Open(ListBox1.List(x))
wdApp.Visible = True
wdApp.Visible = True
Set wdRng = wdApp.Selection
wdRng.Find.Style = wdDoc.Styles("Heading 1")
wdRng.Find.Text = "SYSTEM PARAMETERS"
wdRng.Find.Forward = True
wdRng.Find.Wrap = wdFindAsk
wdRng.Find.Format = True
wdRng.Find.MatchCase = False
wdRng.Find.MatchWholeWord = False
wdRng.Find.MatchByte = False
wdRng.Find.MatchWildcards = False
wdRng.Find.MatchSoundsLike = False
wdRng.Find.MatchAllWordForms = False
wdRng.Find.Execute
wdRng.MoveRight

With wdDoc.Bookmarks
.Add Range:=wdRng.Range, Name:="Start"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
wdRng.Find.Style = wdDoc.Styles("Heading 1")
wdRng.Find.Text = "APPENDIX"
wdRng.Find.Forward = True
wdRng.Find.Wrap = wdFindAsk
wdRng.Find.Format = True
wdRng.Find.MatchCase = False
wdRng.Find.MatchWholeWord = False
wdRng.Find.MatchByte = False
wdRng.Find.MatchWildcards = False
wdRng.Find.MatchSoundsLike = False
wdRng.Find.MatchAllWordForms = False
wdRng.Find.Execute
wdRng.MoveUp
With wdDoc.Bookmarks
.Add Range:=wdRng.Range, Name:="End"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Set aRange = wdDoc.Range( _
Start:=wdDoc.Bookmarks("Start").Range.End + 1, _
End:=wdDoc.Bookmarks("End").Range.Start - 1)
aRange.Copy
Workbooks.Add
ActiveSheet.Paste
wdDoc.Close savechanges:=False
wdApp.Quit
End Sub[/VBA]

Thanks,
Ann