AW: Zellen werden bei Änderungen verschoben
25.05.2021 09:14:06
ede
Hallo nochmal,
stimmt, da ist noch ein zweiter Fehler drin, das Löschen des Zellbreiches verusacht dein Problem, anbei der geänderte Code:
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
Ede