https://www.herber.de/bbs/user/63526.xls
Private Sub ComboBox1_Change()
Dim wksStTab As Worksheet, wksPlan As Worksheet
Set wksSteuerTab = Worksheets("Steuertbl_Std_Ansätze_Seg.")
Set wksPlan = Worksheets("Plandaten")
With wksSteuerTab
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Select Case Application.WorksheetFunction.Index(.Range("B40:B45"), _
Me.ComboBox1.ListIndex + 1, 1)
Case "EIG"
' MsgBox "EIG"
.Range("B4:D9").Copy
wksPlan.Range("B14:D19").PasteSpecial Paste:=xlPasteValues
.Range("B11:D13").Copy
wksPlan.Range("B42:D44").PasteSpecial Paste:=xlPasteValues
.Range("B15:D16").Copy
wksPlan.Range("B48:D49").PasteSpecial Paste:=xlPasteValues
.Range("B18:D18").Copy
wksPlan.Range("B53:D53").PasteSpecial Paste:=xlPasteValues
Case "EII"
' MsgBox "EII"
.Range("F4:H9").Copy
wksPlan.Range("B14:D19").PasteSpecial Paste:=xlPasteValues
.Range("F11:H13").Copy
wksPlan.Range("B42:D44").PasteSpecial Paste:=xlPasteValues
.Range("F15:H16").Copy
wksPlan.Range("B48:D49").PasteSpecial Paste:=xlPasteValues
.Range("F18:H18").Copy
wksPlan.Range("B53:D53").PasteSpecial Paste:=xlPasteValues
Case "XXX"
' MsgBox "XXX"
Case "XYZ"
' MsgBox "XYZ"
Case "ABC"
' MsgBox "ABC"
Case Else
MsgBox "Für """ & Me.ComboBox1.Value & """ ist noch kein Case-Code vorhanden"
End Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End With
End Sub