mein Code kann bis jetzt die im Blatt "Cashflow" markierte Zeile löschen und dann nachsehen in welchen Spalten der Tabelle Formeln stehen und dann ab der Zeile über der gelöschten Zeile die Formeln nach unten hin kopieren (damit die Bezüge wieder stimmen).
Im Blatt "Cashflow" stehen in Spalte 1 Nummern und im Blatt "MwSt" auch in Spalte 1.
Mein Code soll dann noch die Zeile mit der selben Nummer in Spalte 1 im Blatt "MwSt" finden, diese dann löschen und auch nachsehen in welchen Spalten Formeln stehen und diese dann nach unten hin kopieren (wie im Blatt "Cashflow")
Das Zeile finden und löschen funktioniert schon, nur das Formeln suchen und kopieren bekomme ich nicht hin.
Kann mir jemand helfen?
Private Sub Zeile_loeschen_Click()
Dim cell As Range, lngAb As Long, lngAnz As Long
SpeedUp True
ActiveSheet.Unprotect Password:="Peter"
If ActiveCell.Row 7 Then
If ActiveCell.Column = 1 Then 'Zelle in Spalte A aktiviert
If MsgBox("Wollen Sie diese Zeile loeschen?", vbOKCancel + vbQuestion, _
"Achtung!") = 1 Then
'Zeile mit der selben Nummer im Blatt "MwSt" finden, löschen und Formeln _
kopieren
If Worksheets("Cashflow").Name = ActiveSheet.Name Then
Worksheets("MwSt").Unprotect Password:="Peter"
With Worksheets("MwSt")
On Error Resume Next
.Rows(.Columns(1).Find(ActiveCell.Value, lookat:=xlWhole, LookIn:=xlValues). _
Row).Delete
On Error GoTo 0
'hier ist wohl der Fehler, man kann hier nicht lngAb verwenden, was dann?
lngAb = ActiveCell.Row
lngAnz = Cells(65536, 1).End(xlUp).Row - lngAb + 2
For Each cell In Rows(lngAb - 1).SpecialCells(xlCellTypeFormulas, 23)
cell.Copy
cell.Offset(1, 0).Resize(lngAnz, 1).PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Next cell
End With
End If
Worksheets("MwSt").Protect Password:="Peter"
'markierte Zeile im Blatt "Cashflow wird gelöscht und Formeln kopieren
Rows(ActiveCell.Row).Delete
'ActiveCell.EntireRow.Delete
'lngAb = ActiveCell.Row
lngAnz = Cells(65536, 1).End(xlUp).Row - lngAb + 2
For Each cell In Rows(lngAb - 1).SpecialCells(xlCellTypeFormulas, 23)
cell.Copy
cell.Offset(1, 0).Resize(lngAnz, 1).PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Next cell
End If
Else
MsgBox "Sie haben keine Zeile markiert!"
ActiveSheet.Protect Password:="Peter"
Exit Sub
End If
Else
MsgBox "Sie können diese Zeile nicht loeschen!"
ActiveSheet.Protect Password:="Peter"
Exit Sub
End If
ActiveSheet.Protect Password:="Peter"
SpeedUp False
End Sub
Grüße aus Berlin