How to scramble tables in word

[gmaxey]

mana,

Yes, you are correct. This should resolve that and still much faster than select, copy, paste:

Sub test5()
    Dim oDic As Object, oRanNumGen As Object
    Dim lngIndex As Long, lngRandom As Long
    Dim lngCount As Long
    Dim oRng As Range, oRng2 As Range
    Dim oTbls As Tables, oTblsDup As Tables
    Dim oDocDup As Document  
    Set oTbls = ActiveDocument.Tables
    Set oDocDup = Documents.Add(ActiveDocument.FullName)
    Set oTblsDup = oDocDup.Tables
    Set oDic = CreateObject("scripting.dictionary")
    Set oRanNumGen = CreateObject("system.random")
    Application.ScreenUpdating = False
    lngCount = oTbls.Count
    Do
         lngRandom = oRanNumGen.next_2(1, lngCount + 1)
         oDic(lngRandom) = Empty
         If oDic.Count = lngCount Then Exit Do
    Loop
    For lngIndex = 1 To oDic.Count
         Set oRng = oTblsDup(oDic.keys()(lngIndex - 1)).Range
         ' oRng.End = oRng.End + 1
         Set oRng2 = oTbls(lngIndex).Range
         oRng2.Tables(1).Delete
         oRng2.FormattedText = oRng.FormattedText
    Next
    oDocDup.Close wdDoNotSaveChanges
    lbl_Exit:
    Set oTbls = Nothing: Set oRng = Nothing: Set oRng2 = Nothing
    Set oDocDup = Nothing: oDic = Nothing: Set oRanNumGen = Nothing
    Exit Sub
End Sub