Thread: Macro not picking up all tables

I realize this is an Excel forum but have a general VBA question I think. I'm trying to copy all tables in a Word document into a new document. This script is only pasting the first one, even though I can debug through it and see that the count of tables is 48 and I can watch i go from 1-48. It pastes the first one time, and then never pastes anything else again. I have a feeling it has to do with either selecting the table or using the correct activated document. I have only one document open at the time it runs (oDoc) and the only other one is the one that's created (oNewDoc). Any help appreciated.

Thanks!

Set oDoc = ActiveDocument
  
 If oDoc.ProtectionType <> wdNoProtection Then
  oDoc.Unprotect
 End If
 
 Set oNewDoc = Documents.Add
 
 oNewDoc.PageSetup.Orientation = wdOrientLandscape
 
 With oNewDoc.PageSetup
  .LeftMargin = CentimetersToPoints(0.75)
  .RightMargin = CentimetersToPoints(0.63)
  .TopMargin = CentimetersToPoints(0.75)
  .BottomMargin = CentimetersToPoints(0.63)
 End With
 
 For i = 1 To oDoc.Tables.Count
    oDoc.Activate
    oDoc.Tables(i).Select
    oDoc.Tables(i).Range.Copy
        
    oNewDoc.Activate
    oNewDoc.Range.MoveEnd
    oNewDoc.Range.Paste
  Next i

Can you post a document with a few tables in it, I don't feel like guessing..
Also, note that the site has a Word forum, so the question is ok.

Did I miss the bit in the code where the copying occurs?

Oh OK. I've moved this to the Word programming zone in the hope that someone who knows Word VBA will happen by.

When I ran your code on a test document, it seemed to be pasting each new table on top of the previously pasted one. Therefore, try this one:

Option Explicit
Sub CopyTable()
    Application.ScreenUpdating = False
    Dim SourceDoc       As Document, _
        Destination     As Document, _
        TableCounter    As Long
        
    Set SourceDoc = ActiveDocument
    Set Destination = Documents.Add
    
    If SourceDoc.ProtectionType <> wdNoProtection Then
        SourceDoc.Unprotect
    End If
    
    Destination.PageSetup.Orientation = wdOrientLandscape
    
    With Destination.PageSetup
        .LeftMargin = CentimetersToPoints(0.75)
        .RightMargin = CentimetersToPoints(0.63)
        .TopMargin = CentimetersToPoints(0.75)
        .BottomMargin = CentimetersToPoints(0.63)
    End With
    Destination.Activate
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    
    For TableCounter = 1 To SourceDoc.Tables.Count
        SourceDoc.Activate
        SourceDoc.Tables(TableCounter).Select
        SourceDoc.Tables(TableCounter).Range.Copy
        Destination.Activate
        
        'move down so that the new table is not pasted ON TOP
        'of the previous table and also not appended to the
        'bottom of the previous table
        
        Selection.TypeParagraph
        Selection.TypeParagraph
        
        'move up so that there is only one line between tables
        
        Selection.MoveUp Unit:=wdLine, Count:=1
        Selection.PasteAndFormat (wdPasteDefault)
        Selection.MoveDown Unit:=wdLine, Count:=1
    Next TableCounter
    
    Application.ScreenUpdating = True
End Sub