bei X in neues Tabellenblatt
03.11.2016 09:36:42
Meike
ich komme mal wieder nicht weiter. Wenn in Tabelle1 ab Zelle K10 ein "X" gesetzt ist, soll die Zelle ab C10 bis AQ in das Tabellenblatt2 kopiert werden. Dies soll dann für alle darunter liegenden Zeilen gelten.
Wenn das "X" im Tabellenblatt1 entfernt wird, soll es auch aus Tabelle2 verschwindet.
Ich habe hier im Archiv ein Beispiel gefunden und meinen Code soweit angepasst. Das kopieren funktioniert auch. Aber beim "löschen" hapert es. Fehler bei
.Range("C10:AQ" & .Cells(.Rows.Count, 44).End(xlUp).Row + 1).ClearContents
Irgendetwas mache ich noch falsch. Kann mir jemand bitte sagen, woran es liegt. *grrr
Viele Grüße
Meike
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim VisibleBereich As Range
Set Bereich = Intersect(Range("C10", Cells(Rows.Count, 44)), Target)
If Not Bereich Is Nothing Then
With Application
.EnableEvents = False
.ScreenUpdating = False
With Range("K9", Cells(Rows.Count, 11).End(xlUp))
.AutoFilter 1, "=x", VisibleDropDown:=False
On Error Resume Next
Set VisibleBereich = Range("C10:AQ" & .Cells(.Cells.Count).Row). _
SpecialCells(xlCellTypeVisible)
Tabelle1.ShowAllData
.AutoFilter
On Error GoTo 0
End With
With Tabelle2
.Range("C10:AQ" & .Cells(.Rows.Count, 44).End(xlUp).Row + 1).ClearContents
If Not VisibleBereich Is Nothing Then
VisibleBereich.Copy .Range("C10")
.Range("C9:AQ" & .Rows.Count).Sort Key1:=.Range("C9"), Order1:=xlAscending, _
_
Header:=xlYes
End If
End With
.EnableEvents = True
.ScreenUpdating = True
End With
End If
End Sub
Anzeige