Hallo, ich bräuchte bitte Hilfe, da ich das Problem einfach nicht finde.
Ich versuche aus meiner Tabelle alle in Spalte 24 mit "x" gekennzeichneten Zeilen in ein neues Worksheet zu kopieren und untereinander aufzulisten.
Später will ich die sortieren und farblich markieren, daher sind sie mit if Bedingungen nach Inhalt aus Zeile 6 aufgeteilt.
'Zähler def.
Dim i As Integer
i = 2
Dim a As Integer
a = 1
Worksheets("Order Summary Sheet").Activate
'Letzte Reihe finden
Dim last2 As Long
last2 = Worksheets("Order Summary Sheet").Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(4, 24).Select
Schleife1:
If last2 > ActiveCell.Row Then
reihe2 = ActiveCell.Row
If ActiveCell.Text = "x" Or ActiveCell.Text = "X" Then
ActiveSheet.Cells(reihe2, 1).Resize(1, 25).Copy
If ActiveCell.Offset(0, -18).Text = "Nevada Colored" Then
If a = 1 Then
Workbooks.Open Filename:="\\SV1SE\Daten\Daten Agnes\Order Summary Stock Sheet\2018\alt\Test\Daten\Priority List.xlsx"
End If
Workbooks("Priority List.xlsx").Activate
ActiveSheet.Paste Destination:=Sheets("Tabelle1").Cells(i, 1)
Workbooks("Order summary sheet.xls").Activate
Worksheets("Order Summary Sheet").Activate
ActiveCell.Offset(1, 0).Select
i = i + 1
a = a + 1
GoTo Schleife1
ElseIf ActiveCell.Offset(0, -18).Text = "Sky Grey" Then
If a = 1 Then
Workbooks.Open Filename:="\\SV1SE\Daten\Daten Agnes\Order Summary Stock Sheet\2018\alt\Test\Daten\Priority List.xlsx"
End If
Workbooks("Priority List.xlsx").Activate
Worksheets("Tabelle1").Activate
ActiveSheet.Paste Destination:=Worksheets("Tabelle1").Cells(i, 1)
Workbooks("Order summary sheet.xls").Activate
Worksheets("Order Summary Sheet").Activate
ActiveCell.Offset(1, 0).Select
i = i + 1
a = a + 1
GoTo Schleife1
ElseIf ActiveCell.Offset(0, -18).Text = "Lemon" Then
If a = 1 Then
Workbooks.Open Filename:="\\SV1SE\Daten\Daten Agnes\Order Summary Stock Sheet\2018\alt\Test\Daten\Priority List.xlsx"
End If
Workbooks("Priority List.xlsx").Activate
Worksheets("Tabelle1").Activate
ActiveSheet.Paste Destination:=Worksheets("Tabelle1").Cells(i, 1)
Workbooks("Order summary sheet.xls").Activate
Worksheets("Order Summary Sheet").Activate
ActiveCell.Offset(1, 0).Select
i = i + 1
a = a + 1
GoTo Schleife1
ElseIf ActiveCell.Offset(0, -18).Text = "Sahara Beige" Then
If a = 1 Then
Workbooks.Open Filename:="\\SV1SE\Daten\Daten Agnes\Order Summary Stock Sheet\2018\alt\Test\Daten\Priority List.xlsx"
End If
Workbooks("Priority List.xlsx").Activate
Worksheets("Tabelle1").Activate
ActiveSheet.Paste Destination:=Worksheets("Tabelle1").Cells(i, 1)
Workbooks("Order summary sheet.xls").Activate
Worksheets("Order Summary Sheet").Activate
ActiveCell.Offset(1, 0).Select
i = i + 1
a = a + 1
GoTo Schleife1
ElseIf ActiveCell.Offset(0, -18).Text = "Wine Red" Then
If a = 1 Then
Workbooks.Open Filename:="\\SV1SE\Daten\Daten Agnes\Order Summary Stock Sheet\2018\alt\Test\Daten\Priority List.xlsx"
End If
Workbooks("Priority List.xlsx").Activate
Worksheets("Tabelle1").Activate
ActiveSheet.Paste Destination:=Worksheets("Tabelle1").Cells(i, 1)
Workbooks("Order summary sheet.xls").Activate
Worksheets("Order Summary Sheet").Activate
ActiveCell.Offset(1, 0).Select
i = i + 1
a = a + 1
GoTo Schleife1
ElseIf ActiveCell.Offset(0, -18).Text = "Colorado Mix" Then
If a = 1 Then
Workbooks.Open Filename:="\\SV1SE\Daten\Daten Agnes\Order Summary Stock Sheet\2018\alt\Test\Daten\Priority List.xlsx"
End If
Workbooks("Priority List.xlsx").Activate
Worksheets("Tabelle1").Activate
ActiveSheet.Paste Destination:=Worksheets("Tabelle1").Cells(i, 1)
Workbooks("Order summary sheet.xls").Activate
Worksheets("Order Summary Sheet").Activate
ActiveCell.Offset(1, 0).Select
i = i + 1
a = a + 1
GoTo Schleife1
ElseIf ActiveCell.Offset(0, -18).Text = "Sun Yellow" Then
If a = 1 Then
Workbooks.Open Filename:="\\SV1SE\Daten\Daten Agnes\Order Summary Stock Sheet\2018\alt\Test\Daten\Priority List.xlsx"
End If
Workbooks("Priority List.xlsx").Activate
Worksheets("Tabelle1").Activate
ActiveSheet.Paste Destination:=Worksheets("Tabelle1").Cells(i, 1)
Workbooks("Order summary sheet.xls").Activate
Worksheets("Order Summary Sheet").Activate
ActiveCell.Offset(1, 0).Select
i = i + 1
a = a + 1
GoTo Schleife1
Else
If a = 1 Then
Workbooks.Open Filename:="\\SV1SE\Daten\Daten Agnes\Order Summary Stock Sheet\2018\alt\Test\Daten\Priority List.xlsx"
End If
Workbooks("Priority List.xlsx").Activate
Worksheets("Tabelle1").Activate
ActiveSheet.Paste Destination:=Worksheets("Tabelle1").Cells(i, 1)
Workbooks("Order summary sheet.xls").Activate
Worksheets("Order Summary Sheet").Activate
ActiveCell.Offset(1, 0).Select
i = i + 1
a = a + 1
GoTo Schleife1
End If
Else
ActiveCell.Offset(1, 0).Select
GoTo Schleife1
End If
End If
|