View Single Post
 
Old 07-27-2019, 05:02 AM
Dzib Dzib is offline Windows 10 Office 2019
Novice
 
Join Date: Jul 2019
Posts: 29
Dzib is on a distinguished road
Default Macro to export a table to Word

Hi,


I've found this nice macro that works fine to copy/paste a table from Excel to Word:


Code:
Sub Export()

Dim wdApp As Object
Dim wd As Object

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
    Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set wd = wdApp.Documents.Add
wdApp.Visible = True

Sheets("INV").Activate
Set Rng = ThisWorkbook.ActiveSheet.Range("A1:D200")
Rng.Copy
    With wd.Range
        .Collapse Direction:=wdCollapseStart
        .InsertParagraphAfter
        .Collapse Direction:=wdCollapseStart
        .PasteSpecial DataType:=1
            With .Find
                 .ClearFormatting
                 .Text = vbTab
                 .Replacement.ClearFormatting
                 .Replacement.Text = " "
                 .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
            End With
    End With
 End Sub
The problem is that the number of columns is fixed but not the number of rows, that's why I've gone until row 200 (I'll never go beyond).
So in the Word doc I have a bunch of empty lines in my table depending on the number of rows is my Excel table.


I've tried to integrate this macro inside my main macro but I can't get it to work, maybe because at first it was a Word macro, dunno if there are differences.



Code:
Sub DeleteEmptyCol2TableRows()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long
With ActiveDocument
  For Each Tbl In .Tables
    With Tbl
      For i = .Rows.Count To 1 Step -1
        If Len(.Cell(i, 2).Range.Text) = 2 Then .Rows(i).Delete
      Next i
    End With
  Next Tbl
End With
Application.ScreenUpdating = True
End Sub

It could work fine if I run this macro from Word after the Word doc has been created but I'd like to run all from Excel in one click.



Any idea?
Reply With Quote