Zeilen kopieren -> Dann löschen
22.04.2020 16:08:05
Sascha
Ich arbeite derzeit an einem Tool zur Auswertung unübersichtlicher Exports aus einem ERP System. Abgesehen von meiner total chaotischen Programmstruktur, da ich kein gelernter Programmierer bin und mich per Google und VBA-Hilfe durchwusele, funktioniert bisher alles sehr gut. Natürlich fehlen einige Routinen um Fehler abzufangen, aber da setze ich mich dann dran, wenn die Grundfunktionen laufen.
Nun ist es so, dass ich für eine spezielle Auswertung folgende Situation vorfinde und ein definiertes Ziel habe:
Quelle: Eine CSV mit mehreren tausend Zeilen -> aus dieser extrahiere ich mir alle relevanten Zeilen und füge Sie schon automatisch in ein neues Tabellenblatt ein -> nun sollen die Einträge gem. der Handelspartner (per ID Nummer in Spalte A) weiter getrennt und in neue Tabellenblätter übertragen werden. Also für jeden Handelspartner ein Blatt.
Soweit so gut. Bisher habe ich mich auf einen Handelspartner beschränkt um die allgemeine Funktion zu realisieren. Im Anschluss war mein Gedanke, eine For Schleife um diese Funktion zu setzen und dann die einzelnen Handelspartner (die sind fest definiert) einfach durch iterieren zu lassen.
Nun ist es aber so, dass meine Funktion alles macht, nur nicht das was ich möchte:
Sub SchwesterFirmenTrennen()
Dim Zeile As Long
Dim zeileMax As Long
Dim delZeile As Integer
Dim n As Integer
Dim wS As Worksheet
Set wS = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook. _
Worksheets.Count))
wS.Name = "Sheet_Neu" 'D03019000
'Application.ScreenUpdating = False
With ActiveWorkbook.Sheets("Ausgabe")
zeileMax = .UsedRange.Rows.Count
n = 2
.Rows(1).Copy Destination:=ActiveWorkbook.Worksheets("Sheet_Neu").Rows(1)
For Zeile = 2 To zeileMax
If .Cells(Zeile, 1).Value = "D03019000" Then
.Rows(Zeile).Copy ActiveWorkbook.Worksheets("Sheet_Neu").Rows(n)
.Rows(Zeile).EntireRow.Delete shift:=xlUp
'.Rows(Zeile).Cut ActiveWorkbook.Worksheets("Sheet_Neu").Rows(n)
n = n + 1
End If
Next Zeile
End With
'Application.ScreenUpdating = True
End Sub
Folgendes Verhalten für folgende Ansätze:
.Rows(Zeile).Copy ActiveWorkbook.Worksheets("Sheet_Neu").Rows(n)
.Rows(Zeile).EntireRow.Delete shift:=xlUp
Lasse ich die "Delete"-Zeile weg, kopiert er alle 55 Einträge rüber, dann habe ich aber noch nicht gelöscht.
Der zweite Ansatz "Cut" funktioniert an sich super, hinterlässt in der Quelle nur leider leere Zeilen, die ich zur weiteren Bearbeitung nicht haben möchte.
Ich hoffe mein Problem ist nachvollziehbar! Ich möchte betonen, dass ich mich durch sämtliche deutsch- und englischsprachigen Foren gewuselt habe, leider aber keine funktionierende Lösung gefunden habe. Vielleicht auch einfach falsch gesucht. Kann mir jemand helfen?
Liebe Grüße
und Danke vorab!
Sascha