VBA code to export data to word with header values

Guessed · #1 07-03-2022, 04:31 AM

Try this code. Put it in your Excel workbook and add a reference to "Microsoft Word x.x Object Library".

Before running the macro, make sure the correct worksheet is active.

This code is putting a duplicate of the first table at the end of the document and adding the Excel data into that new table. It repeats for each pair of rows in Excel.

Code:

Sub Write2Word()
  Dim wdDoc As Word.document, wdTbl As Word.Table, wdApp As Object, wdRng As Word.Range
  Dim iRow As Integer, aSheet As Worksheet, iCol As Integer, iPair As Integer
  Dim sPath As String
  Set aSheet = ActiveSheet
  iRow = 2
  sPath = ActiveWorkbook.Path & "\"
  Set wdApp = CreateObject("Word.Application")
  wdApp.Visible = True
  
  Set wdDoc = wdApp.Documents.Add(sPath & "OUTPUT_RESULT-FILE.docx")  'creates new doc based on this file
  
  Do While aSheet.Cells(iRow, 1).Value <> ""
    Set wdRng = wdDoc.Range
    wdRng.Collapse Direction:=0
    wdRng.InsertBefore Chr(13) & Chr(13)
    wdRng.Collapse Direction:=0
    wdRng.FormattedText = wdDoc.Tables(1).Range.FormattedText
    Set wdTbl = wdRng.Tables(1)
    For iPair = 0 To 1
      For iCol = 0 To 7
        wdTbl.Cell(iCol + 1, iPair + 2).Range.Text = aSheet.Cells(iRow, 1).Offset(iPair, iCol).Value
      Next iCol
    Next iPair
    iRow = iRow + 2
  Loop
End Sub

jackfruit88 · #2 07-03-2022, 04:18 PM

its works but its not insert each image on each page , its place 2 or 3 image in each page can u do help on tis please?

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Export data to word table	Dzib	Excel Programming	7	08-28-2019 11:51 PM
Export Access report as pdf -- save as .rft -- and Word puts some text into the header	louiseword	Word	1	11-21-2016 04:32 PM
VBA Export Data as Text from Excel to Word	lwbarnes	Word VBA	3	06-09-2016 02:47 PM
need vba code export data to closed workbook sheets	manilara	Excel Programming	1	02-12-2016 08:20 PM
Export Word Form Data to Access	pboland	Word VBA	1	06-12-2015 06:53 PM