PDA

View Full Version : [SOLVED] Many urgent excel at vertical instead of horizontal word



k0st4din
09-21-2012, 11:04 AM
Hello to all the great minds of VBA.
Is there someone who can make a macro to copy excel written down in box A: A word document again vertically A1, A2, A3, etc.
Or because this macro works very well, but if you can touch anywhere hirizontalno instead, carry information vertically - >>> this would be the best option.
Thanks in advance
Sub AutoFillWordTables()

Dim C As Long
Dim FileFilter As String
Dim LastCol As Long
Dim R As Long
Dim Rng As Excel.Range
Dim WordFile As String
Dim wdApp As Object
Dim wdDoc As Object
Dim wdTbl As Object
Dim Wks As Worksheet

Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A1:A6")

LastCol = Wks.Cells(Rng.Row, Columns.Count).End(xlToLeft).Column
Set Rng = Rng.Resize(ColumnSize:=LastCol)

FileFilter = "Word Documents(*.doc),*.doc, All Files(*.*),*.*"
WordFile = Excel.Application.GetOpenFilename(FileFilter)

If WordFile = "False" Then Exit Sub

Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Open(WordFile)

For C = 1 To LastCol
Set wdTbl = wdDoc.Tables(C)
For R = 1 To Rng.Rows.Count
wdTbl.Range.Cells(R).Range.Text = Rng.Cells(R, C)
Next R
Next C

wdApp.Visible = True

Set wdApp = Nothing
Set wdDoc = Nothing
Set wdTbl = Nothing

End Sub

Simon Lloyd
09-21-2012, 11:19 AM
Sorry but your post makes very little sense!

k0st4din
09-22-2012, 08:07 AM
Honest I do not know how much more info you need. There is an excel file that has this code, which works perfectly but carries information in "word" horizontally, and because you do not know much - obviously need somewhere to change a little something in the code itself, instead of horizontally to vertically transmitted in writing "word" document.
Open a new "word" - insert table, only 6 rows down and 6 to the right and look at the attached picture. Thanks in advance

Simon Lloyd
09-22-2012, 02:02 PM
Try changing this bitFor C = 1 To LastCol
Set wdTbl = wdDoc.Tables(C)
For R = 1 To Rng.Rows.Count
wdTbl.Range.Cells(R).Range.Text = Rng.Cells(R, C)
Next R
Next C
for this
Set wdTbl = wdDoc.Tables(1)
For R = 1 To Rng.Rows.Count
wdTbl.Range.Cells(R).Range.Text = Rng.Cells(R, 1)
Next R

snb
09-22-2012, 03:27 PM
Sub snb()
With ThisDocument.Tables(1)
For j = 1 To .Rows(1).Cells.Count
.Cell(j, 1).Range.Text = .Cell(1, j).Range.Text
Next
End With
End Sub

k0st4din
09-23-2012, 12:39 AM
Hi Simon, thank you very much for the help from your side.
It works perfectly. I knew it needs to be touched anywhere, but you do not understand so many macros, and wrote to ask.
Thank you very much.
As SNB - and put your code, but gave me an error, something is done, but no matter the important thing is that it works with other code.
Thank you all