Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1964to1968
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilen übertragen und löschen

Zeilen übertragen und löschen
12.02.2024 16:34:10
Chris_H
Hallo zusammen,

wir haben bei uns eine Liste mit den offenen Angeboten. Wenn aus einem Angebot eine Bestellung wird, soll die Excel die entsprechende Zeile aus dem Angebots-Reiter kopieren und in den Reiter "Bestellungen" reinschieben.
Leider bekomme ich dann aber einen Fehler. "keine Zellen gefunden. Laufzeitfehler 1004"
Normalerweise wird das Angebot welches verschoben werden soll, in einer Spalte mit einem "x" markiert, dann wird ein Button gedrückt und die Zeile wandert vom Reiter "Angebote" in den Reiter "Bestellungen".

Leider habe ich selbst noch sehr wenig Ahnung von VBA, weshalb ich euch hier behelligen muss/möchte.

Hier der Code aus dem VBA. Beim Debuggen werde ich auf den FETT geschrieben Teil im VBA hingewiesen. (wird im VBQ gelb markiert)

Sub Verschieben_Angebot_Bestellte()
Dim lngLetzteAB As Long
Dim lngErsteAB As Long
Dim lngZeileAB As Long

' Abfrage ob Makro ausgeführt werden soll
If MsgBox("Sind Sie sicher die Änderungen vorzunehmen?", vbYesNo) = vbNo Then
Exit Sub
End If
'Verschieben der Zeile von Angebote in Beauftragungen
lngLetzteAB = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
For lngZeileAB = 1 To lngLetzteAB
With Worksheets("Bestellungen")
If Cells(lngZeileAB, 14) = "x" Then
lngErsteAB = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1 'Erkennen der ersten beschreibbaren Zeile anhand Spalte 2
Rows(lngZeileAB).Copy .Cells(lngErsteAB, 1)
Rows(lngZeileAB).ClearContents
Worksheets("Bestellungen").Cells(lngErsteAB, 1).Copy
.Cells(lngErsteAB, 11).PasteSpecial Paste:=xlValues
Worksheets("Bestellungen").Cells(lngErsteAB, 1).ClearContents
Worksheets("Bestellungen").Range(.Cells(lngErsteAB, 13), .Cells(lngErsteAB, 15)).ClearContents
End If
End With
Next lngZeileAB
'Löschen der leeren Zeilen im Arbeistblatt
Range(Cells(3, 1), Cells(lngLetzteAB, 1)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


Ich hoffe ihr könnt mir weiterhelfen.
Mir ist nur eine Sache aufgefallen:
Wenn zwischen zwei Zeilen im Bereich Angebot noch Leerzeilen sind, ich dann auf "Übertragen" gehe, um ein Angebot zu den Bestellungen zu überführen, dann bekomme ich keinen Fehler. Stattdessen werden die Lererzeilen einfach gelöscht und die List wird - sagen wir mal - aufgeräumt.
Aber ansonsten passiert nichts?!

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen übertragen und löschen
12.02.2024 17:15:36
ReginaR
Hi,

hier muss es meiner meinung nach statt Spalte 14, Spalte 15 heißen. Dann entsteht auch eine Leerzeile, die glöscht werden kann:

If Cells(lngZeileAB, 15) = "x" Then

VG Regina
AW: Zeilen übertragen und löschen
19.02.2024 13:42:30
Chris_H
Hi Regina,

das hat leider nicht die Lösung gebracht. Der von dir angemerkte Bereich wird mir auch nicht als "fehlerhaft" in gelb angezeigt.

Hier nochmal der Code:

Sub Verschieben_Angebot_Bestellte()
Dim lngLetzteAB As Long
Dim lngErsteAB As Long
Dim lngZeileAB As Long

' Abfrage ob Makro ausgeführt werden soll
If MsgBox("Sind Sie sicher die Aenderungen vorzunehmen?", vbYesNo) = vbNo Then
Exit Sub
End If
'Verschieben der Zeile von Angebote in Beauftragungen
lngLetzteAB = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
For lngZeileAB = 1 To lngLetzteAB
With Worksheets("Bestellungen")
If Cells(lngZeileAB, 15) = "x" Then
lngErsteAB = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1 'Erkennen der ersten beschreibbaren Zeile anhand Spalte 2
Rows(lngZeileAB).Copy .Cells(lngErsteAB, 1)
Rows(lngZeileAB).ClearContents
Worksheets("Bestellungen").Cells(lngErsteAB, 1).Copy
.Cells(lngErsteAB, 11).PasteSpecial Paste:=xlValues
Worksheets("Bestellungen").Cells(lngErsteAB, 1).ClearContents
Worksheets("Bestellungen").Range(.Cells(lngErsteAB, 13), .Cells(lngErsteAB, 15)).ClearContents
End If
End With
Next lngZeileAB
'Löschen der leeren Zeilen im Arbeistblatt
Range(Cells(3, 1), Cells(lngLetzteAB, 1)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete (DIESE ZEILE WIRD MIR IN GELB MARKIERT. ANSCHEINEND MUSS HIER DER FEHLER LIEGEN?)
End Sub
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige