![]() |
|
|
|
#1
|
||||
|
||||
|
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: HTML Code:
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
![]() Cendrinne |
|
#2
|
||||
|
||||
|
Perhaps you want something like:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, r As Long, c As Long
With ActiveDocument.Tables(1)
For r = .Rows.Count To 1 Step -1
For c = .Columns.Count To 2 Step -1
If r = .Rows.Count Then
.Rows.Add
Else
.Rows.Add .Rows(r + 1)
End If
Set Rng = .Cell(r, c).Range
Rng.End = Rng.End - 1
.Cell(r + 1, 1).Range.FormattedText = Rng.FormattedText
Next
Next
For c = .Columns.Count To 2 Step -1
.Columns(c).Delete
Next
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#3
|
||||
|
||||
|
Well, this results is by row in from each column.
I wish to have it by column, as for Column 1, apply all rows, then go to column 2, apply all rows, then so forth. Or else I could have used from Table to Text which would have given me that same result. That is why is was so challenging for me to find a way, manually to use every row in each columns. But thank you for trying, Paul. Have another Idea? |
|
#4
|
||||
|
||||
|
That's just a matter of transposing the process:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, r As Long, c As Long
With ActiveDocument.Tables(1)
If .Columns.Count * .Rows.Count > 63 Then
MsgBox "Too many cells - 63 is the maximum supported", vbCritical
Exit Sub
End If
For c = .Columns.Count To 1 Step -1
For r = .Rows.Count To 2 Step -1
If c = .Columns.Count Then
.Columns.Add
Else
.Columns.Add .Columns(c + 1)
End If
Set Rng = .Cell(r, c).Range
Rng.End = Rng.End - 1
.Cell(1, c + 1).Range.FormattedText = Rng.FormattedText
Next
Next
For r = .Rows.Count To 2 Step -1
.Rows(r).Delete
Next
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#5
|
||||
|
||||
|
Hummmmm, I'm getting an error message. My system is in French, so I'll try to translate. Execution error 5258. The maximum width has been reached, when I click on Debug, it goes to the row: .Columns.Add
Then I see it transposed to the right on row 1. I've created another one, with only two columns, It works unless I've used an additional macro to delete empty rows, then I get another error message. Geeeeeze, it's so freaking challenging. Let me get the other macro with two columns. See if we can figure out something.
|
|
#6
|
||||
|
||||
|
Quote:
Code:
.AutoFitBehavior wdAutoFitWindow Code:
Set Rng = .Cell(r, c).Range
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#7
|
||||
|
||||
|
I had to fix something, sorry for the delay
![]() Code:
Sub T1fr_Merge_2Col_Vertically_in_1_col_TST()
'This macro is to have every row in each column, under each other, as 1 column
Application.ScreenUpdating = False
' Select column l, then go to Column 2
Selection.SelectColumn
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCell
Selection.EndKey Unit:=wdRow, Extend:=True
Selection.EndKey Unit:=wdColumn, Extend:=True
'Select column 2, Cut then paste below table 1
Selection.Copy
Selection.Cut
Selection.EndKey Unit:=wdColumn, Extend:=True
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeParagraph
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdRow, Extend:=True
Selection.HomeKey Unit:=wdColumn, Extend:=True
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.EndKey Unit:=wdRow, Extend:=True
Selection.EndKey Unit:=wdColumn, Extend:=True
' 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:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
'Resize the whole table as 1 column, page wide
Selection.Tables(1).Select
Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
NestedTables:=False
Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, _
NumRows:=31, AutoFitBehavior:=wdAutoFitFixed
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
|
|
#8
|
||||
|
||||
|
But the thing is that I only had 2 or 3 columns MAX to test this out. I don't understand the maximun width. The only thing I could think of, was I had put AutoFit Window.
I'll see if I modify the script with what you just written |
|
#9
|
||||
|
||||
|
Quote:
(PS: A Word table cannot have more than 63 columns).
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#10
|
||||
|
||||
|
If this is what I was supposed to do, it made it worst:
It transposed a column for every text rows. Hikes ![]() Code:
Sub T1fr_Merge_3Col_Vert_en_1_sous_TST_BETTER2()
'From Forum, created by macropod Paul Edstein 2021-02-17
Application.ScreenUpdating = False
Dim Rng As range, r As Long, c As Long
With ActiveDocument.Tables(1)
For c = .Columns.Count To 1 Step -1
For r = .Rows.Count To 2 Step -1
If c = .Columns.Count Then
.Columns.Add
Else
.Columns.Add .Columns(c + 1)
End If
.AutoFitBehavior wdAutoFitWindow
Set Rng = .cell(r, c).range
Rng.End = Rng.End - 1
.cell(1, c + 1).range.FormattedText = Rng.FormattedText
Next
Next
For r = .Rows.Count To 2 Step -1
.Rows(r).Delete
Next
End With
Application.ScreenUpdating = True
End Sub
Execution error 5941 The required Collection member does not exist. (again, my system is in French, and I'm translating it). I've done it again, to copy the script error message, now it gave me another error code: 4198, the Command failed Then under Debug: it went to line: cColumns.Add .Columns(c + 1) I'm beyond tired now. Going to bed, but it was nice catching up with you ![]() Thanks for trying. until next time, Cendrinne |
|
#11
|
||||
|
||||
|
Well, what you said in post #3 was:
which is what it now does. Since there is obviously a communication issue here, perhaps you could attach a document to a post showing 'before' and 'after' views of your table, both views containing some sample data.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#12
|
||||
|
||||
|
Hi Paul,
I was trying to find a way to write this message privately, but I can't. I don't think I'm aloud to show images, unfortunately. That would mean granting access to my work pc, which I'm not aloud. So I try to be clear. I know as I reread it, it's challenging to really show what I mean at times, plus the language barrior ![]() I truly appologize if I've confused, what I meant, and when I wrote, ''Or else I could have used from Table to Text which would have given me that same result.'' I truly didn't mean it to be disrespectful, if it came out that way. Thank you for the lesson ![]() Cendrinne |
|
#13
|
||||
|
||||
|
All I asked was that you:
The data don't even have to be 'real' - provided they show what the table should look like 'before' and 'after'.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#14
|
||||
|
||||
|
Quote:
I'll try to adapt ![]() thanks a million Paul
|
|
| Tags |
| error message, pasteandformat table |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Word Error Message Run time Error 4605 | baes10 | Word VBA | 1 | 08-30-2018 02:37 PM |
| Error Message | PointCheck | Word VBA | 1 | 08-13-2018 02:42 PM |
| No known fix for this error message... | Aymincendiary | PowerPoint | 1 | 09-03-2017 05:38 PM |
Reserved error(-1517); there is no message for this error
|
ktest | Office | 1 | 02-12-2016 08:08 PM |
Automation error Unknown error" message once they open the Excel file
|
hlina | Excel | 1 | 10-08-2013 09:14 PM |