Private Sub Cmbx_Click()
For Each Zelle In Range("A2:A42")
Cmbx.AddItem Zelle.Value
Next
End Sub
Sub selectedItem()
Dim Zelle As Integer
With Me.Cmbx
If .ListIndex < 0 Then
MsgBox ("Es wurde keinen Eintrag ausgewählt")
Else
Zelle = CInt(.ListIndex) + 2
Call ueberschriftenkopieren(Zelle)
End If
End With
End Sub
Sub ueberschriftenkopieren(Zellennr As Integer)
Dim R1, R2, Rng As Range
Dim AnfangSpalte, EndeSpalte As Integer
AnfangSpalte = 2
EndeSpalte = 16
If (Zellennr > 0) Then
For Spalte = AnfangSpalte To EndeSpalte
If (Cells(Zellennr, Spalte).Value = "x") Then
ThisWorkbook.Worksheets("Tabelle1").Cells(Zellennr, Spalte).Value = Cells(1, Spalte).Value
End If
Next
End If
End Sub
Private Sub But_Click()
Call selectedItem
End Sub