Need help, get error message when place tbl....

[Cendrinne]

Hello, Pros,
I'm desprately trying to fix a macro I've created to have every column in a table, from Column 1 (top to bottom), then next column (top to bottom), then next column (top to bottom), etc. place as ONE Column. I've started with 3 columns, to have 1.

Well I keep getting an error message when it wants to pasteAndFormat



What am I doing wrong? Cause when I do step by step (F8), it works.

We need to put the starting cursor in column 1, then use this macro:

Sub T1fr_Merge_3Col_Vert_as_1_TST_BETTER()
'This macro is to have every Rows, from each column in a table from Left to Right, under each other, as 1 column

'T1fr_Fusionne_3Col_Vert_en_1_sous_TST_BETTER
'  TST_Selection_Col_2n3_Start_Col1_part1 Macro
'
Application.ScreenUpdating = False
'
' Select column l, then go to Column 2
    
    ActiveDocument.Tables(1).Columns(2).Select
    Selection.SelectColumn
    Selection.EndKey Unit:=wdRow, Extend:=True
    Selection.EndKey Unit:=wdColumn, Extend:=True

'Select column 2+3, Cut then paste below table 1
    Selection.Copy
    Selection.Cut
    Selection.EndKey Unit:=wdColumn, Extend:=True
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.MoveUp Unit:=wdLine, Count:=2
    Selection.MoveRight Unit:=wdCell
    Selection.SelectColumn
    Selection.EndKey Unit:=wdColumn, Extend:=True
    
'Select column 3, Cut then paste below table 2
    Selection.Copy
    Selection.Cut
    Selection.EndKey Unit:=wdColumn
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    
'  Remove extra paragraph marks to get all tables as 1
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdColumn
    Selection.MoveUp Unit:=wdLine, Count:=2
    Selection.Delete Unit:=wdCharacter, Count:=2
    
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdColumn
    Selection.MoveUp Unit:=wdLine, Count:=2
    Selection.Delete Unit:=wdCharacter, Count:=2
    
'Resize the whole table as 1 column, page wide
    Selection.SelectColumn
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    Exit Sub

Application.ScreenUpdating = True
    
    On Error GoTo 0

End Sub

Any insights, please let me know, it's driving me crazy

Cendrinne