Follow

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use
Contact

Paste a table from Excel into Word then transform it

I am beginner at coding with VBA. So, although the following code works very well, I am looking for a way to optimize and reduce it.

Its objective is to:

1- paste a table from Excel into Word without losing Excel format

MEDevel.com: Open-source for Healthcare and Education

Collecting and validating open-source software for healthcare, education, enterprise, development, medical imaging, medical records, and digital pathology.

Visit Medevel

2- process the pasted table

3- move out of the table, then add new line/empty paragraph

Sub TablePasteAndTransform()    
    
    With Selection

        ' paste from excel at the cursor position
        .Collapse Direction:=wdCollapseStart
        .PasteAndFormat wdFormatOriginalFormatting
        .MoveUp Unit:=wdLine, Count:=1
        
        .Collapse Direction:=wdCollapseStart
        If Not .Information(wdWithInTable) Then
            MsgBox "Can only run this within a table"
            Exit Sub
        End If
        
        With .Tables(1)
            ' process the pasted table
            .AutoFitBehavior (wdAutoFitWindow)            
            .Cell(1, 1).PreferredWidthType = wdPreferredWidthPoints
            .Cell(1, 1).PreferredWidth = 75
            .Select
        End With

        .Collapse wdCollapseEnd        
        .Range.InsertAfter vbCrLf
        .MoveDown Unit:=wdParagraph
        
    End With

    ThisDocument.Save
    
End Sub

>Solution :

For example:

Sub TablePasteAndFormat()
Application.ScreenUpdating = False
With ActiveDocument
  With Selection.Range
    .Collapse (wdCollapseStart)
    .PasteExcelTable False, False, False
    With .Tables(1)
      .AutoFitBehavior (wdAutoFitWindow)
      .Cell(1, 1).PreferredWidthType = wdPreferredWidthPoints
      .Cell(1, 1).PreferredWidth = 75
      .Range.Characters.Last.Next.InsertBefore vbCrLf
    End With
  End With
  .Save
End With
Application.ScreenUpdating = False
End Sub
Add a comment

Leave a Reply

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use

Discover more from Dev solutions

Subscribe now to keep reading and get access to the full archive.

Continue reading