Daten splitten funktioniert nicht
26.11.2019 15:12:18
Okan
ich habe ein problem, was ich selber nicht lösen kann.
Ich habe ein Makro erstellt, welcher nur bis zu "' Tabellenblatt SAP Split mit Daten füllen" funktioniert und danach in eine Endlosschliefe geht.
Dabei muss ich dann excel sofort beenden.
Hier ist der Code:
Sub process_start()
' DAIMLER Prozess Start
' DAIMLER Daten kopieren und in neue Tabellenblatt einfuegen; Tabellenblatt umbennen in "DAG"
Range("H:I,K:K,Q:Q,D:D,F:F").Select
Range("F1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "DAG"
' Primary Key DAIMLER Tabellenblatt erstellen; Primary Key bis zum letzten Datensatz (Spalte B) _
ziehen
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "Primary Key"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=RC[3]&""PM-""&RC[1]"
Range("A2").Select
Dim Ende As Long, arr, ze, anz, z
With ActiveSheet
Ende = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2").AutoFill Destination:=Range("A2:A" & Ende), Type:=xlFillDefault
End With
' Tabellenblatt DAG kopieren und an Ende stellen; Doppelte Werte DAIMLER Tabellenblatt _
entfernen; Tabellenblattbezeichnungen aendern; Formel für Spalte F bis zum letzten Datensatz (Spalte A) einfügen
Sheets("DAG").Select
Sheets("DAG").Copy After:=Sheets(4)
Sheets("DAG").Select
Columns("A:G").Select
ActiveSheet.Range("$A:$G").RemoveDuplicates Columns:=1, Header:= _
xlYes
Range("F2").Select
ActiveCell.FormulaR1C1 = _
"=SUMIF('DAG (2)'!C[-5]:C,DAG!RC[-5],'DAG (2)'!C)"
Range("F2").Select
With ActiveSheet
Ende = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("F2").AutoFill Destination:=Range("F2:F" & Ende), Type:=xlFillDefault
End With
' Tabellenblatt DAIMLER entfernen
Sheets("DAIMLER").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("SAP Daten").Select
' DAIMLER vorbereitung Prozess Ende
' SAP Daten Vorbereitung Prozess start
' Molsheim Tabellenblatt wird erstellt
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$I").AutoFilter Field:=2, Criteria1:="101263"
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Sheets("Tabelle3").Select
Sheets("Tabelle3").Name = "101263"
' Im Tabellenblatt SAP Daten werden die Molsheim Daten gelöscht; Es wird nach Lieferscheinen "" Then
del = Cells(z, 1)
ship = Cells(z, 2)
w = Cells(z, 3)
anz = Cells(z, 4)
SU = Cells(z, 5)
GI = Cells(z, 6)
Cty = Cells(z, 7)
ame = Cells(z, 8)
shPT = Cells(z, 9)
Sheets("SAP Split").Cells(ze, 1) = del
Sheets("SAP Split").Cells(ze, 2) = ship
Sheets("SAP Split").Cells(ze, 3) = w
Sheets("SAP Split").Cells(ze, 4) = anz
Sheets("SAP Split").Cells(ze, 5) = SU
Sheets("SAP Split").Cells(ze, 6) = GI
Sheets("SAP Split").Cells(ze, 7) = Cty
Sheets("SAP Split").Cells(ze, 8) = ame
Sheets("SAP Split").Cells(ze, 9) = shPT
For i = 1 To UBound(arr, 1)
If w = arr(i, 1) Then
Sheets("SAP Split").Cells(ze, 1) = del
Sheets("SAP Split").Cells(ze, 2) = ship
Sheets("SAP Split").Cells(ze, 3) = arr(i, 2)
Sheets("SAP Split").Cells(ze, 4) = anz
Sheets("SAP Split").Cells(ze, 5) = SU
Sheets("SAP Split").Cells(ze, 6) = GI
Sheets("SAP Split").Cells(ze, 7) = Cty
Sheets("SAP Split").Cells(ze, 8) = ame
Sheets("SAP Split").Cells(ze, 9) = shPT
ze = ze + 1
Sheets("SAP Split").Cells(ze, 1) = del
Sheets("SAP Split").Cells(ze, 2) = ship
Sheets("SAP Split").Cells(ze, 3) = arr(i, 3)
Sheets("SAP Split").Cells(ze, 4) = anz
Sheets("SAP Split").Cells(ze, 5) = SU
Sheets("SAP Split").Cells(ze, 6) = GI
Sheets("SAP Split").Cells(ze, 7) = Cty
Sheets("SAP Split").Cells(ze, 8) = ame
Sheets("SAP Split").Cells(ze, 9) = shPT
'Stop
End If
Next i
ze = ze + 1
End If
Next z
' Primary Key SAP Split Tabellenblatt erstellen; Primary Key bis zum letzten Datensatz (Spalte _
B) ziehen
Sheets("SAP Split").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "Primary Key"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=RC[1]&RC[3]"
Range("A2").Select
With ActiveSheet
Ende = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2").AutoFill Destination:=Range("A2:A" & Ende), Type:=xlFillDefault
End With
' Tabellenblatt SAP entfernen
Sheets("SAP").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
MsgBox ("Makro abgeschlossen!")
End Sub
Ich bedanke mich im Voraus für eure Hilfe.Mit freundlichen Grüßen
Okan Firat