Hallo zusammen,

Ich bin ziemlicher Neuling was VBA angeht und versuche mich an einem Programm, welches nach jeder vollen Spalte eine leere Spalte einfügt. Dann soll noch der Inhalt der Spalte A in die neuen leeren Spalten einfügt werden. Genauer gesagt geht es um Messdaten wo in Spalte A der Zeitstempel steht. Der Zeitstempel muss aber neben jede Messdaten einzeln.

Ich habe schon ein Programm gefunden, welches ich ein wenig verfeinert habe. Ich kann bereits den Bereich auswählen, in welchem der Befehl durchgeführt werden soll. Ein ein Intervall für die leeren Spalten kann ich auch schon festlegen. Danach komme ich aber nicht wirklich weiter. Aus welchem Grund auch immer, kann ich auch nur alle 2 Spalten eine neue einfügen. Ein Befehl für das kopieren und einfügen von Spalte A fehlt mir eider auch noch. 

Vieleicht kann mir ja die Schwarmintiligenz den Knoten im Kopf lösen.

Untenstehend ist das Programm wie ich es bis jetzt habe. Die auskommentierten Befehle habe ich als Makro erstellt und führen das aus was ich haben will. Es soll halt automatiert für einen frei wählbaren Bereich funktionieren und nicht darauf beschränkt sein, wie oft ich den Befehl als Makro ausgeführt habe.

Sub EveryOtherColumn()
Dim rng As Range
Dim InputRng As Range
Dim OutRng As Range
Dim xInterval As Integer
Dim xTitleId As String
Dim i As Integer
xTitleId = "Zeitstempel kopieren und einfügen"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Bereich :", xTitleId, InputRng.Address, Type:=8)
xInterval = Application.InputBox("Spaltenintervall eingeben", xTitleId, Type:=1)
For i = 1 To InputRng.Columns.Count Step xInterval + 1
    Set rng = InputRng.Cells(1, i)

    If OutRng Is Nothing Then
        Set OutRng = rng
    Else
        Set OutRng = Application.Union(OutRng, rng)
    End If
 
Next
  OutRng.EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
   
    'Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    'Columns("A:A").Select
    'Selection.Copy
    'Columns("C:C").Select
    'ActiveSheet.Paste
    'Columns("E:E").Select
    'Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    'Columns("A:A").Select
    'Selection.Copy
    'Columns("E:E").Select
    'ActiveSheet.Paste
 

End Sub

Vielen Dank schonmal !!