Worksheet_Change

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Hugo,
Du hast leider (entschuldige) keinen guten VBA Ansatz.
1. Der Makkro-Recorder mach viel redundanten Code.
Select brauch man fast nie!
2. Die _Change Prozedur wird mehrfach aufgerufen (z.B. Zeile einfügen) das kann man zwar auschalten aber behebt Dein Problem nicht (Application.EnableEvents = False; Einschalten nicht vergessen auch bei Fehler; sonnst geht nix mehr).
3. Beim Einfügen von Zeilen oder Spalten muss bedacht werden, das dann ActiveCell plötzlich eine Zeile höher oder tiefer adressiert, je nach dem. Übrigen habe ich mir das abgewöhnt damit handelt man sich nur Probleme ein, die man an irgend einer Stelle übersieht. Und mehr Zeilen gewinnst Du auch nicht.
4. Versuche Deinen Ansatz zu überdenken es gibt meist einen bessern.
Ich hoffe etwas geholfen zu haben.
Armin

Habe dies nun wie folgend gelöst. Für Profis wahrscheinlich unsauber aber läuft.
Sollte doch noch eine bessere Lösung erscheinen nehme ich sie gerne an
Besten Dank und Gruss


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Cells.Offset(1, 0).EntireRow.Hidden = False Then Exit Sub
On Error GoTo Ende
If Target.Column = 2 And Target.Cells.Offset(1, 0).EntireRow.Hidden = True Then
Application.EnableEvents = False
Target.Cells.Select
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
ActiveCell.Offset(1, 0).EntireRow.Select
Selection.Copy
ActiveCell.Offset(-1, 0).EntireRow.Select
Selection.PasteSpecial Paste:=xlFormats
Selection.PasteSpecial Paste:=xlFormulas
Application.CutCopyMode = False
Selection.EntireRow.Hidden = False
Target.Cells.Offset(0, 0).Select
Application.EnableEvents = True
Else
Target.Cells.Offset(0, 0).Select
End If
Exit Sub
Ende:
Exit Sub
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Offset(0, 0).EntireRow.Hidden = True Then
ActiveCell.Offset(-3, 0).Select
End If
End Sub

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not (Target.Column = 2 And Target.Offset(1, 0).EntireRow.Hidden = False) Then On Error GoTo Ende Application.EnableEvents = False Target.Offset(1, 0).EntireRow.Insert Target.Offset(1, 0).EntireRow.Copy With Target.Offset(-1, 0).EntireRow .PasteSpecial Paste:=xlFormats .PasteSpecial Paste:=xlFormulas .EntireRow.Hidden = False End With Application.CutCopyMode = False Target.Cells.Offset(0, 0).Select Else Target.Cells.Offset(0, 0).Select End If Ende: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread