Extraktionsmakro

Private Sub EXPORT_Click() Dim WsAll As Worksheet Dim WsDel As Worksheet Dim LetzteZeile&, I&, J&, X&, LetzteZeileDel& Set WsAll = ActiveWorkbook.Worksheets(1) Set WsDel = ActiveWorkbook.Worksheets(2) LetzteZeile = WsAll.Cells.SpecialCells(xlCellTypeLastCell).Row 'letzte Zeile ernmitteln LetzteZeileDel = WsDel.Cells.SpecialCells(xlCellTypeLastCell).Row 'letzte Zeile in Del ernmitteln X = 5 'Startzeile in delivered For I = 5 To LetzteZeileDel If WsDel.Cells(I, 3) = "" Then X = I Exit For End If Next For I = 5 To LetzteZeile If UCase(WsAll.Cells(I, 10)) = "DELIVERED" Then For J = 3 To 10 WsDel.Cells(X, J) = WsAll.Cells(I, J) Next X = X + 1 WsAll.Rows(I).Delete I = I - 1 End If Next Set WsAll = Nothing Set WsDel = Nothing End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Halle Reno,
ich geh davon aus dass Dein Problem in den Zeilen fuer LetzteZeile und LetzteZeileDel steckt.
Schoene Gruesse
Stefan B.


Private Sub EXPORT_Click()
Dim WsAll As Worksheet
Dim WsDel As Worksheet
Dim LetzteZeile&, I&, J&, X&, LetzteZeileDel&
Set WsAll = ActiveWorkbook.Worksheets(1)   'gibt dem Code die Moeglichkeit dass erste Worksheet als WsAll anzusprechen
Set WsDel = ActiveWorkbook.Worksheets(2)   'gibt dem Code die Moeglichkeit dass zweite Worksheet als WsDel anzusprechen
LetzteZeile = WsAll.Cells.SpecialCells(xlCellTypeLastCell).Row  'letzte Zeile ermitteln (kann nicht funktionieren, da xlCellTypeLastCell nicht initialisiert ist
LetzteZeileDel = WsDel.Cells.SpecialCells(xlCellTypeLastCell).Row 'letzte Zeile in Del ernmitteln (kann nicht funktionieren, da xlCellTypeLastCell nicht initialisiert ist
X = 5   'Startzeile in delivered
For I = 5 To LetzteZeileDel    'Schleifenstart um von 5 bis zur Zahl LetzteZeileDel zu laufen
If WsDel.Cells(I, 3) = "" Then 'Abfrage ob der Wert der Zelle (I,3) ="" ist
X = I                      'Falls ja, dann soll X den augenblicklichen Wert von I bekommen
Exit For                   'Noch immer falls ja: beende die Schleife
End If
Next
For I = 5 To LetzteZeile  'Schleifenstart von 5 bis Zahl LetzteZeile
If UCase(WsAll.Cells(I, 10)) = "DELIVERED" Then 'prueft ob der Wert der Zelle (I,10) "delivered", "DELIVERED", "Delivered" oder irgendeine andere schreibweise des Wortes ist
For J = 3 To 10   'Schleifenstart von 3 bis 10
WsDel.Cells(X, J) = WsAll.Cells(I, J) 'Schreibt in die erste freie Zeile im zweiten Workbook in die Spalte J den Wert aus der Zelle (I,J) des ersten Workbooks
Next
X = X + 1 'Erhoeht den Wert von X um 1
WsAll.Rows(I).Delete 'Loescht die Zeile (I) im ersten Workbook
I = I - 1 'verringert die Zahl I, da ja jetzt eine Zeile fehlt
End If
Next
Set WsAll = Nothing 'gibt den Speicher fuer WsAll wieder frei
Set WsDel = Nothing 'gibt den Speicher fuer WsDel wieder frei
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread