Tabellengröße per VBA ändern

Question

Hallo,

ich habe ein Tabellenblatt mit vielen Tabellen nebeneinander. Jede Tabelle ist eine Spalte breit, zwischen den Tabellen ist derzeit immer eine Spalte leer. Nun möchte ich jede Tabelle um die leere Spalte rechts daneben erweitern, also aus der Tabelle $A$1 soll nun zum Beispiel die Tabelle $A$1:$B$20 werden. Am liebsten soll die dazugenommene Spalte als Tabellenüberschrift in der ersten Zeile auch immer die Bezeichnung "Name" tragen.

Ist dies per VBA möglich (statt dass man immer die Tabelle größer zieht oder auf "Tabellengröße ändern " klicken muss?)

Viele Grüße

ulinet

Answer 1

Guten Morgen

Sollte in etwa mit

Sub Makro1()
For Each mytabelle In ActiveSheet.ListObjects
    mytabelle.Resize Range(Cells(mytabelle.Range.Row, mytabelle.Range.Column), Cells(20, mytabelle.Range.Column + mytabelle.Range.Columns.Count - 1 + 1))
    Cells(mytabelle.Range.Row, mytabelle.Range.Column + mytabelle.Range.Columns.Count - 1).Value = "Name"
Next

End Sub

funktionieren

Answer 2

Hi,

ganz einfach so, weil sich die Tabelle automatisch erweitert wenn in die Nachbarspalte etwas eingetragen wird:

Sub TabErweitern()
    Dim lstObj As ListObject
    For Each lstObj In ActiveSheet.ListObjects
        lstObj.HeaderRowRange.Cells(1).Offset(0, 1) = "Name"
    Next lstObj
End Sub

Bis später, Karin

Answer 3

Hallo

@Anonym: Das funktioniert perfekt, vielen Dank!

@Karin: So geht es nicht ganz. Die Tabellenüberschrift "Name" ist schon mal da, aber wenn ich in die Nachbarspalte eintrage, erweitert sich die Tabelle nicht automatisch. Mit der Lösung von Anonym klappt es nun. Trotzdem danke

Viele Grüße,

ulinet

Answer 4

Hi,

doch, das geht schon auf diesem Weg, nur hast du nicht geschrieben, dass "Name" bereits in der Zelle steht, und das kann man ja nicht wissen. In diesem Fall muss nan nur ganz einfach vorher die Zelle leeren und dann erneut eintragen:

Sub TabErweitern()
    Dim lstObj As ListObject
    For Each lstObj In ActiveSheet.ListObjects
        lstObj.HeaderRowRange.Cells(1).Offset(0, 1).ClearContents
        lstObj.HeaderRowRange.Cells(1).Offset(0, 1) = "Name"
    Next lstObj
End Sub

Bis später, Karin