Zellen löschen
Chris
folgendes Makro kopiert mir Zellen mit bestimmten Werten in ein anderes Tabellenblatt und listet diese untereinander auf. Läuft so weit. Wenn In Tabelle 1 der Wert einer Zelle im Rangebereich von 4 auf 3
oder ein anderer Wert kleiner als 4, geändert wird, sollen die bereits kopierte Zelle(en) in Tabelle zwei inhaltlich gelöscht werden.
Mir fällt da im Moment nur ein "Aktualiseren"-Button ein.
hat jemand evtl. einen Vorschlag?
Private Sub Worksheet_change(ByVal target As Range)
Dim rngZ As Range
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim lngLetzteZeile As Long
Set wksQuelle = ActiveWorkbook.Worksheets("tabelle1")
Set wksZiel = ActiveWorkbook.Worksheets("tabell2")
For Each rngZ In wksQuelle.Range("O15:O121")
If rngZ.Value ="4" Then
lngLetzteZeile = wksZiel.Cells(wksZiel.Rows.Count, 3).End(xlUp).Row
wksZiel.Cells(lngLetzteZeile + 1, 3).Value = rngZ.Value
wksZiel.Cells(lngLetzteZeile + 1, 2).Value = wksQuelle.Cells(rngZ.Row, rngZ.Column - 13). _
Value
End If
Next
lngLetzteZeile = 0
For Each rngZ In wksQuelle.Range("S15:S121")
If rngZ.Value ="5" Then
lngLetzteZeile = wksZiel.Cells(wksZiel.Rows.Count, 8).End(xlUp).Row
wksZiel.Cells(lngLetzteZeile + 1, 8).Value = rngZ.Value
wksZiel.Cells(lngLetzteZeile + 1, 7).Value = wksQuelle.Cells(rngZ.Row, rngZ.Column - 17). _
Value
End If
Next
Application.CutCopyMode = False
End Sub
Cpttuttle
Anzeige