Zeile in and. Blatt finden, Zellen mit Formeln kop

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

For Each cell In Rows("keine Ahnung" - 1).SpecialCells(xlCellTypeFormulas, 23) cell.Copy cell.Offset(1, 0).Resize(lngAnz, 1).PasteSpecial _ Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, _ Transpose:=False Next cell

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

Hallo, Peter,
es kann sein, dass es nun ein wenig kompliziert wird, nicht wegen der VBA-Möglichkeiten zur Lösung der Aufgabe, sondern eher wegen der Möglichkeit, in einem bestehenden Programmcode, der viele Anzeichen aufweist, dass er bereits auch in etlichen Schritten "bedarfsgerecht" zusammengesetzt wurde, Änderungen vorzunehmen, die zu unbeabsichtigten Nebeneffekten führen, deie ich selbst noch nicht überblicken kann.
Zum ersten ist da, dass in der Beispieldatei das Tabellenblatt "CashFlow" frei von Zellenfolrmeln ist, somit das Übertragen der Zellenformel auf in der Spalte darunterligende Zellen nicht erforderlich wird; oder hat die Originalmappe auf dieser Tabelle Formeln?
Zweitens ist mir der Summenteil +2 in der Bereichsweitenformel lngAnz = .Cells(65536, 1).End(xlUp).Row - lngAb + 2 nicht klar, was jedoch kein sonderliches Problem aufwirft, da hierdurch eben nur die Formeln um eine Zeile weiter geschrieben wird, als Formeln in der Spalte vorhanden sind und dieser Effekt einfach dadurch eliminiert wird, dass eben als Summand +1 gesetzt werden kann.
Zur Vorgehensweise beim nachfolgendem Test, schlage ich vor, dass Du in einer Beispielmappe

die bestehende Funktion Private Sub Zeile_loeschen_Click() umbenennest in Private Sub Zeile_loeschen_V0_Click(), o.ä. um dann
den nachfolgenden Programmcode für die Prozedur Private Sub Zeile_loeschen_Click() in das gleiche Modul einzufügen.


Private Sub Zeile_loeschen_Click()
Dim cell As Range
Dim lngAb As Long, lngAnz As Long
If Worksheets("Cashflow").Name  ActiveSheet.Name Then
MsgBox ("Aufruf nur vom Tabellenblatt ChashFlow aus möglich!" & vbLf & "Keine weitere  _
Aktion!")
Exit Sub
End If
SpeedUp True
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
With Worksheets("MwSt")
.Unprotect Password:="Peter"
On Error Resume Next
lngAb = .Columns(1).Find(ActiveCell.Value, lookat:=xlWhole, LookIn:= _
xlValues).Row
.Rows(lngAb).Delete
On Error GoTo 0
'hier ist wohl der Fehler, man kann hier nicht lngAb verwenden, was dann?
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
.Protect Password:="Peter"
End With
'markierte Zeile im Blatt "Cashflow wird gelöscht und Formeln kopieren
With ActiveSheet
.Unprotect Password:="Peter"
.Rows(ActiveCell.Row).Delete
' ab hier könnte der Programmteil entfallen; s.u.
lngAb = ActiveCell.Row
On Error GoTo 0
lngAnz = .Cells(65536, 1).End(xlUp).Row - lngAb + 2
For Each cell In .Rows(lngAb - 1)
If cell.HasFormula Then
With cell
.Copy
.Offset(1, 0).Resize(lngAnz, 1).PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:= _
False, _
Transpose:=False
End With
End If
Next cell
' bis hierher könnte der Programmteil ab dem Beginnhinweis gelöscht werden; s.u.
.Protect Password:="Peter"
End With
End If
Else
MsgBox "Sie haben keine Zeile markiert!"
Exit Sub
End If
Else
MsgBox "Sie können diese Zeile nicht loeschen!"
Exit Sub
End If
SpeedUp False
End Sub

Testen und Prüfung der Wikungen.

Im wesentlichen ist der Programmcode so geblieben, wie er bisher vorgesehen waren, bis auf dass ein paar Umgruppierungen vorgenommen wurden, die jedoch wohl von ihrem Grundgedanken her nachvollziehbar sind.
Der Programmcode kann um den Bereich


lngAb = ActiveCell.Row
On Error GoTo 0
lngAnz = .Cells(65536, 1).End(xlUp).Row - lngAb + 2
For Each cell In .Rows(lngAb - 1)
If cell.HasFormula Then 'SpecialCells(xlCellTypeFormulas, 23)
cell.Select
With cell
.Copy
.Offset(1, 0).Resize(lngAnz, 1).PasteSpecial _
Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:= _
False, _
Transpose:=False
End With
End If
Next cell

gekürzt werden, wenn die Tabelle "CashFlow" keine Zellenformeln enthällt, die angepaßt werden müssen.
Gruß,
Uwe

Hallo, Peter,
.....
1. das Blatt "Cashflow" hat Formeln, sie sind bei dir wohl auf den ersten Blick nicht zu sehen , weil in den Codes die Blätter immer schreibgeschützt werden. Das Passwort ist "Peter".
....
Nein, das ist wohl nicht der Fall, denn die For Each cell In Rows(lngAb - 1).SpecialCells(xlCellTypeFormulas, 23) bezogen auf die CashFlow-Tabelle führt zum Fehler, der nur dann auftritt, wenn keine Zellenformaln in dem genannten Bereich gefunden werden. Daher die Umwandlung der Abfrage, die im Falle, dass keine Zwellenformel gefundenwird, auch zu keiner weiteren Aktion führt.
....
2. Da hast du recht.
....
Womit habe ich recht? Vermag den Bezug nicht zu erkennen.
...
Unter den Bedingungen nützt mir dein Vorschlag leider nichts.
...
Welche Bedingungen nutzt Dir mein Vorschlag nichts? Hast Du den Code laufen lassen? Und wenn, ja, welche Unzulänglichkeiten hast Du festgestellt?
...
Hast du noch eine Idee? Der Code muss schon den Bedingungen aus meiner letzten Nachricht folgen!
...
Tut er es denn nicht? Und wenn ja, an welchen Punkten (siehe bitte auch vorherige Antwort)? Ggf. können wir auch versuchen, direkt die Probleme zu besprechen, denn momentan fehlt die Zeit, mich länger in die mögliche Gesamtthematik einzuarbeiten.
Gruß,
Uwe

Private Sub Zeile_loeschen_Click() Dim cell As Range Dim lngAb As Long, lngAnz As Long SpeedUp True 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 With Worksheets("MwSt") .Unprotect Password:="Peter" On Error Resume Next lngAb = .Columns(1).Find(ActiveCell.Value, lookat:=xlWhole, LookIn:= _ xlValues).Row .Rows(lngAb).Delete On Error GoTo 0 'Im Blatt "MwSt" Formeln kopieren 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 .Protect Password:="Peter" End With 'markierte Zeile im Blatt "Cashflow löschen With ActiveSheet .Unprotect Password:="Peter" .Rows(ActiveCell.Row).Delete 'Im Blatt "Cashflow" Formeln kopieren lngAb = ActiveCell.Row On Error GoTo 0 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 .Protect Password:="Peter" End With End If Else MsgBox "Sie haben keine Zeile markiert!" Exit Sub End If Else MsgBox "Sie können diese Zeile nicht loeschen!" Exit Sub End If SpeedUp False End Sub

Beliebteste Forumthreads (12 Monate)

Zeile in and. Blatt finden, Zellen mit Formeln kop

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile in and. Blatt finden, Zellen mit Formeln kop

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread