Ændre kolonnebredde automatisk på en variable tabel via vba

Ændre kolonnebredde automatisk på en variable tabel

Jeg har en tabel some er 4,31cm bred pr kolonne, der skal kortes ned til 3 cm. Pr. kolonne.

Tabellen er indpasted fra et andet dokument, proceduren skal gentages ca. 2-300 gange, og hver gang vil antallet af linier være forskellige.

Nedenstående makro kode, kan håndtere mit behov når tabellen er statisk i sin størrelse, d.v.s. lige mange rækker hver gang.
Hvordan laver en makro der tæller antallet af linier og bruger resultatet, således nedenstående makro gør det rigtige.

4,31cm bredde

Pensionsbidrag

    aaa            bbb    ccc    I alt
01.01.2005    9 %    3 %    12 %
01.01.2006    9 %    4 %    13 %
01.01.2007    10 %    5 %    15 %


Sub bidrag()

  Selection.GoTo What:=wdGoToBookmark, Name:="bidrag_start"
  Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
    Selection.Columns.PreferredWidth = CentimetersToPoints(3)
  End Sub
 

Jeg har faktisk en ligende udfordring hvor mit worddokument skal kigge ind i en excel fil og paste en række udfyldte celler.
Udfordringen er også her at området hvor data står  fra case til case, har forskellige antal rækker/linier. Vedlagte makro, kan håndtere mit behov, når data er er statisk i sin størrelse, d.v.s. har lige mange linier hver gang.

Sub hent ()

Dim xlApp As Object

Set xlApp = CreateObject("excel.application")
xlApp.Visible = True

xlApp.workbooks.Open FileName:="C:\udtræk til statusrapport.xls"

xlApp.Range("j98:k103").Select
xlApp.Selection.Copy

Selection.GoTo What:=wdGoToBookmark, Name:="tilvalggrafisk"
    With ActiveDocument.Bookmarks
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.PasteAndFormat (wdFormatPlainText)
xlApp.Quit
Set xlApp = Nothing
End Sub

Det vil altid være således at 1.position i arket vil være j 98:k98  men jeg ved ikke hvor mange linier der udfyldes. Jeg vil kunne anføre et maks område hvor jeg ved at det ikke kommer ud over eks. J98:k110. Men problemet er så at det vil være forskelligt fra sag til sag hvor mange linier, og der med celler der er udfyldt og hvor mange der er tomme, jeg skal kun have pasted de ikke tommer celler i området.

Er det muligt at lave et tillæg til vedlagte makro, der kan håndtere denne udfordring.
Eller vil det være nemmere at overføre maks området j 98;k110, og benytte evt. makroen fra den 1. angivne udfordring?

Med venlig hilsen


HHB