344 Aufrufe
Gefragt in Tabellenkalkulation von ulinet Einsteiger_in (42 Punkte)
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

4 Antworten

+1 Punkt
Beantwortet von
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
+1 Punkt
Beantwortet von

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

0 Punkte
Beantwortet von ulinet Einsteiger_in (42 Punkte)

Hallo

@Anonym: Das funktioniert perfekt, vielen Dank! smileyyes

@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 smiley

Viele Grüße,

ulinet

0 Punkte
Beantwortet von beverly_ Experte (3.4k Punkte)

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

...