Nach jeder Spalte neue Spalte einfügen

Hallo,
ich habe hier in einer Tabelle eine rheie von Spalten. Ich möchte nun nach jeder Spalte eine neue Spalte einfügen. In der Tabelle sind ca 1000 Spalten ich würde das gerne per Makro löschen, leider weiß ich nicht wie.
Zusätzlich soll in der Neuen Spalte der Name der Zelle links davon übernommen werden
Bsp.
wenn ich in
D2 Gruppe x und in D3 Gruppen-ID stehen habe, dann soll in
E2 Gruppe x und in E3 Gruppen-ID stehen.
Ich bräucht also jeweils immer die Überschrieften der Inhalt danach also ab D4 und E4 usw. wäre irrelevant.
Zusätzlich soll in den neun Zeilen der Spalte ab z.b. D4 noch ein bestimmtes Drop-down menü erscheinen, mit JA / Nein, ist das über ein Makro realisierbar?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Roland
bestimmt nicht die flotteste Methode, aber mit meinen bescheidenen VBA Kenntnissen weiß ich es auf die Schnelle nicht besser.
Option Explicit

Sub Test()
Dim Spalte1 As String, Spalte2 As String, i As Long, LoSpa As Long
Application.ScreenUpdating = False
Spalte1 = "Gruppe x"
Spalte2 = "Gruppen-ID"
LoSpa = Cells(2, Columns.Count).End(xlToLeft).Column
For i = 1 To LoSpa
If Cells(2, i) = Spalte1 Or Cells(2, i) = Spalte2 Then
Cells(2, i + 1).EntireColumn.Insert
End If
Next
For i = 1 To LoSpa
If Cells(2, i) = "" Then
Cells(2, i) = Cells(2, i - 1)
End If
Next
Application.ScreenUpdating = True
End Sub

funktioniert aber, denke ich.
Gruß Uwe

Sub Test() Dim i As Long, LoSpa As Long Application.ScreenUpdating = False LoSpa = Cells(2, Columns.Count).End(xlToLeft).Column + 4 For i = 1 To LoSpa If Cells(2, i) "" Then Cells(2, i + 1).EntireColumn.Insert Next For i = 1 To LoSpa If Cells(2, i) = "" Then Cells(2, i) = Cells(2, i - 1) If Cells(3, i) = "" Then Cells(3, i) = Cells(3, i - 1) Next Application.ScreenUpdating = True End Sub

Option Explicit Sub ColsAdd() Dim j As Long Dim lngLC As Long Application.ScreenUpdating = False With Sheets("Tabelle1") lngLC = .Cells(2, .Columns.Count).End(xlToLeft).Column For j = lngLC To 1 Step -1 .Columns(j + 1).Insert .Cells(2, j + 1).Resize(2) = .Cells(2, j).Resize(2).Value Next End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Nach jeder Spalte neue Spalte einfügen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Nach jeder Spalte neue Spalte einfügen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread