Gruß
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ende
ActiveSheet.Unprotect Password:="info"
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not (Intersect(Range("B15,D15,F15,H15,B36,D36,F36,H36"), Target) Is Nothing) Then
Target.Offset(1).Resize(6).ClearContents
Target.Offset(1).Resize(6).ClearFormats
Select Case Target.Value
Case "Kl"
Worksheets("Liste Auswahl").Range("A2:A5").Copy Target.Offset(1)
Case "einst"
Worksheets("Liste Auswahl").Range("A11:A16").Copy Target.Offset(1)
Case "Un"
Worksheets("Liste Auswahl").Range("A25:A28").Copy Target.Offset(1)
Case "Sonstiges"
Worksheets("Liste Auswahl").Range("A19:A22").Copy Target.Offset(1)
End Select
Application.CutCopyMode = False
End If
ende:
Target.Offset(1).Resize(6).RowHeight = 24.75
Application.EnableEvents = True
ActiveSheet.Protect Password:="info"
End Sub