-
Progressing a bit further! This is the latest. The following code works! BUT if you look at the line Set rng = .Range("A7") ' Cells(r+5, (4 * t) -c -2)) you will see that I managed to make it work with just one cell ("A7") but i need the proper syntax or object definition to make it work with the Cells method. Anybody can see the glitch? I am almost there...
[vba]Sub TransferExcelToWord()
Dim rng As Range 'Source ranges
Dim wdApp As Object, wdDoc As Object
Dim myWordFile As String 'path to Word template
Dim t, r, c As Integer
'initializing the template located in same directory
myWordFile = ThisWorkbook.Path & "\test3.dotx"
'On Error GoTo ErrFix
Set wdApp = CreateObject("Word.Application")
'open a new word document from the template
Set wdDoc = wdApp.Documents.Add(myWordFile)
'loop to copy the ranges into word tables
'although not elegant, I resorted to copy every single cell one by one
' there are 4 ranges on a sheet: A6:C31, E6:G31, I6:K31, M6:o31
For t = 1 To 4 'Loop to cycle through the tables(ranges)
For r = 1 To 25 'loop to cycle through the rows
For c = 1 To 3 ' loop to cycle through the columns
'Selecting the ranges from the Excel file
With Sheets("Sheet2")
Set rng = .Range("a7") 'Cells(r + 5, (4 * t) - c - 2))
End With
'paste the cell to the appropriate table in word
'begin with cell (2,1) to preserve the headers
With wdDoc.Tables(t)
.Cell(r + 1, c).Range.Text = rng
End With
Next c
Next r
Next t
'With wdDoc.Tables(t)
' .Columns.AutoFit
'End With
Application.CutCopyMode = False
wdDoc.SaveAs "C:\Users\Systeme\Documents\Work\*****\Daily\Europe" & Format(Date, "ddmmyy") 'change to suit
wdDoc.Close savechanges:=False
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "Finished"
Exit Sub
ErrFix:
On Error GoTo 0
MsgBox "Error"
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
[/vba]
Thanks for reading
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules