Adjust widht of table when exporting from Excel to Word

[RinorM]

Hi I have the following code that pastes copied value within a range form Excel to Word:

Sub Createrapport()Dim WS As Worksheet


Set WS = Worksheets("Rapport")
Application.ScreenUpdating = False
    Sheets("Rapport").Visible = True


Dim UserName As String
UserName = InputBox(Prompt:="Var vänligen och ange ditt namn nedan:")
If UserName = vbNullString Then
Exit Sub
Else
WS.Range("I1").Value = UserName
End If




    Dim wdApp As Object
    Dim wd As Object
    Dim Tbl 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
    
    Sheets("Rapport").Activate
    Set wd = wdApp.Documents.Add
    wdApp.Visible = True
    
    'sidhuvud
    wdApp.ActiveWindow.ActivePane.View.SeekView = 9
    With wd
        Set Tbl = .Tables.Add(wdApp.Selection.Range, 2, 3, wdWord8TableBehavior)
        Tbl.Cell(1, 1).Range.Text = WS.Range("K4").Text
        Tbl.Cell(1, 2).Range.Text = WS.Range("L4").Text
        Tbl.Cell(1, 3).Range.ParagraphFormat.Alignment = 2 'wdAlignParagraphRight
        Tbl.Cell(1, 3).Range.Text = WS.Range("I1").Text
        Tbl.Cell(2, 1).Range.Text = WS.Range("K5").Text
        Tbl.Cell(2, 3).Range.ParagraphFormat.Alignment = 2 'wdAlignParagraphRight
        Tbl.Cell(2, 3).Range.Text = WS.Range("M5").Text
    End With
    wdApp.ActiveWindow.ActivePane.View.SeekView = 0


    'sidnummer
    'Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PAGE  ", PreserveFormatting:=True
    
    '***** copy image from cell H11:M411 in Excel
    Worksheets("Rapport").Range("H11:M41").Copy
    '***** past image at the current position in Word
    wdApp.Selection.Paste
      


Set rng = Worksheets("Rapport").Range("A1:E203")


rng.Copy


   With wd.Range
        .collapse Direction:=0                  '****et av dokumentet
        .InsertParagraphAfter                   'Lägg till rad
        .collapse Direction:=0                  '****et av dokumentet
        .PasteSpecial False, False, True        'Pasta som Enhanced Metafile
   End With




  Set myTable = _
    wd.Tables.Add(Range:=wdApp.Selection.Range, NumRows:=3, _
    NumColumns:=3)


'***** Word constant wdPreferredWidthPercent = 2
myTable.PreferredWidthType = 2
myTable.PreferredWidth = 100


myTable.Cell(2, 1).SetWidth _
    ColumnWidth:=wdApp.InchesToPoints(1.5), _
    RulerStyle:=0 '*****wdAdjustNone
     
    Sheets("Rapport").Visible = False
    Application.ScreenUpdating = True


End Sub

it generates the picture below. How can I re-write the code so that It is within the margins. I've tried it a couple of hours but I cant seem to fix it. Would appreciate any kind of help. Thank you.