Kann mir bitte jemand helfen?
Gruß Volker
https://www.herber.de/bbs/user/146346.xlsm
sRg2 = Target.Offset(1, 0).Resize(6).Address
Gruss
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sRg1 As String, sRg2 As String
On Error GoTo ende
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not (Intersect(Range("B15,D15,F15,H15,B34,D34,F34,H34"), Target) Is Nothing) Then
''Debug.Print Target.Address
sRg1 = Target.Offset(1, 0).Address
sRg2 = Target.Offset(1, 0).Resize(6).Address
''Debug.Print sRg1, sRg2
' Worksheets("RAST").Range(sRg2).Delete Shift:=xlToLeft
Worksheets("RAST").Range(sRg2).ClearContents
Worksheets("RAST").Range(sRg2).ClearFormats
Select Case Target.Value
Case "Kl"
Worksheets("Liste Auswahl").Range("A2:A5").Copy
Worksheets("RAST").Range(sRg1).PasteSpecial xlAll
Case "einst"
Worksheets("Liste Auswahl").Range("A11:A16").Copy
Worksheets("RAST").Range(sRg1).PasteSpecial xlAll
Case "Un"
Worksheets("Liste Auswahl").Range("A25:A28").Copy
Worksheets("RAST").Range(sRg1).PasteSpecial xlAll
End Select
Application.CutCopyMode = False
End If
ende:
Worksheets("RAST").Range(sRg2).EntireRow.RowHeight = 24.75
Application.EnableEvents = True
End Sub
gruss
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ende
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not (Intersect(Range("B15,D15,F15,H15,B34,D34,F34,H34"), 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)
End Select
Application.CutCopyMode = False
End If
ende:
Target.Offset(1).Resize(6).RowHeight = 24.75
Application.EnableEvents = True
End Sub
Gruß Werner
Target.Offset(1).Resize(6).RowHeight = 24.75
so wie es in der ersten Vorschlag von Ede drin war:
Target.Offset(1).Resize(6).EntireRow.RowHeight = 24.75
Beim ersten wird versucht, die Höhe einzelnen Zellen, beim zweiten, die Höhe der ganzen Zeilen zu setzen.