ich habe ein Makro gebastelt, dass super funktioniert hat, bis ich auf die glorreiche Idee kam, noch einen Baustein hinzuzufügen.
Ziel der Erweiterung war es, das die Linien, welche im Bearbeitungssheet anhand von 2 Kriterien auch im Daily Sheet enthalten sind, aus dem Bearbeitungssheet gelöscht werden, also die ganze Zeile, leider funktioniert es nicht könnt Ihr mir bitte helfen?
Hier der Teil der nicht funktioniert:
' Dieser Teil funktioniert leider nicht
For j = 1 To LRendi
For BRowCounter = 3 To SRendi
Yep = Sheets("Daily Sheet").Range("K" & BRowCounter).Value
Nope = Sheets("Daily Sheet").Range("O" & BRowCounter).Value
If Sheets("Bearbeitungssheet").Range("K" & j).Value = Yep And Sheets("Bearbeitungssheet").Range("O" & j).Value = Nope Then
Sheets("Bearbeitungssheet").ActiveCell.EntireRow.Delete
' Sheets("Bearbeitungssheet").Range("K" & j).Value.EntireRow.Delete
End If
Next BRowCounter
Next j
Und hier das komplette Makro:
Sub Rollit()
' Rollit
Dim Useful As Variant
Dim AlsoUseful As Variant
Dim Yep As Variant
Dim Nope As Variant
Dim LRendi As Long
Dim L2endi As Long
Dim lngDestinationRowCounter As Long
Dim BRowCounter As Long
Dim j As Long
Dim ReiheVar As Long
Dim SRendi As Long
Dim Found As Boolean
Dim strFileName
LRendi = Sheets("Bearbeitungssheet").Range("A" & Rows.Count).End(xlUp).row
Sheets("Daily Sheet").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("Bearbeitungssheet").Select
SRendi = LRendi
Columns("A:W").Select
Selection.EntireColumn.Hidden = False
Range("A1").Select
ChDir _
"C:\Suspense"
Workbooks.Open Filename:= _
"S:\International \Global.xls"
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Cells.Select
Selection.Copy
Windows("TestRS.xlsm").Activate
Sheets("Daily Sheet").Activate
Range("A1").Select
ActiveSheet.Paste
Columns("O:O").Delete
Range("A1").Select
ReiheVar = 1
' Dieser Teil funktioniert leider nicht
For j = 1 To LRendi
For BRowCounter = 3 To SRendi
Yep = Sheets("Daily Sheet").Range("K" & BRowCounter).Value
Nope = Sheets("Daily Sheet").Range("O" & BRowCounter).Value
If Sheets("Bearbeitungssheet").Range("K" & j).Value = Yep And Sheets(" _
Bearbeitungssheet").Range("O" & j).Value = Nope Then
Sheets("Bearbeitungssheet").ActiveCell.EntireRow.Delete
' Sheets("Bearbeitungssheet").Range("K" & j).Value.EntireRow.Delete
End If
Next BRowCounter
Next j
' Ab hier geht es wieder
L2endi = Sheets("Daily Sheet").Range("A" & Rows.Count).End(xlUp).row
For j = 1 To L2endi
For lngDestinationRowCounter = 2 To SRendi
Useful = Sheets("Bearbeitungssheet").Range("K" & lngDestinationRowCounter).Value
AlsoUseful = Sheets("Bearbeitungssheet").Range("O" & lngDestinationRowCounter).Value
If Sheets("Daily Sheet").Range("K" & j).Value = Useful And Sheets("Daily Sheet").Range(" _
O" & j).Value = AlsoUseful Then
Sheets("Daily Sheet").Range("K" & j).Value = "Found"
End If
Next lngDestinationRowCounter
Next j
For j = 1 To L2endi
If Sheets("Daily Sheet").Range("K" & j).Value "Found" And Sheets("Daily Sheet").Range("K" _
& j).Value "Copied" Then
Sheets("Daily Sheet").Select
Range("A" & j).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Bearbeitungssheet").Select
Range("A" & LRendi + 1).Select
ActiveSheet.Paste
LRendi = LRendi + 1
Sheets("Daily Sheet").Range("K" & j).Value = "Copied"
End If
Next j
Sheets("Bearbeitungssheet").Select
Range("A:B,H:J,M:M,R:V").EntireColumn.Hidden = True
End Sub
Vielen Dank und viele Grüße
Franky