AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 16:08:51
Felix
Hi Daniel,
danke für deine Geduld, diesen Testlauf habe ich ausprobiert, er führt das Kopieren nur für die erste Zeile aus, in der jedoch Überschriften stehen...
Scheinbar liegt dort der Fehler:
Mein kompletter Code:
Sub Button()
'Sortieren der Geschäfte, Ausschluss von Geschäften der Art ,,AllgGebühr"
'Kopieren der Blätter "Geschäfte_anzeigen" und "TR-Pool" in Blatt "Abgleich"
Sheets("Geschäfte_anzeigen").Activate
Range("A1:I1").AutoFilter Field:=5, Criteria1:="AllgGebühr"
Sheets("TR-Pool").Activate
Range("A1:GB1").AutoFilter Field:=6, Criteria1:="Geschäfte"
Range("A1:GB1").AutoFilter Field:=15, Operator:=xlOr, Criteria1:="N", Criteria2:="C"
Sheets("Geschäfte_anzeigen").Range("A1:I100").Copy Sheets("Abgleich").Range("A1")
Sheets("TR-Pool").Range("F1:O100").Copy Sheets("Abgleich").Range("K1")
Sheets("Abgleich").Activate
'Vergleich Geschäfte und TR-Pool
Dim GeschNr As Range ' Variable Bereich 2
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
With Worksheets("Abgleich")
' 1. Schleife alle Zellen Bereich2
For Each GeschNr In .Range("P2:P100")
If Application.CountIf(.Range("F2:F100"), GeschNr) _
= 0 And GeschNr "" Then GeschNr.Interior.ColorIndex = 4
Next GeschNr
' 1. Schleife alle Zellen Bereich1
For Each GeschNr In .Range("F2:F100") ' 1. Schleife alle Zellen Bereich2
If Application.CountIf(.Range("P2:P100"), GeschNr) _
= 0 And GeschNr "" Then GeschNr.Interior.ColorIndex = 4
Next GeschNr
End With
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein
'Bei Abweichungen zwischen Geschäftsnummern wird der jeweilige Bereich farbig markiert und in _
das Blatt "Output" kopiert
'Bereich1
Dim lz As Long
Dim zel As Range
lz = Sheets("Output").Range("A65000").End(xlUp).Row
For Each zel In Sheets("Abgleich").UsedRange.Columns(6)
If zel.Interior.ColorIndex = 4 Then
Sheets("Output").Range("A" & lz + 1).Resize(1, 8) = Sheets("Abgleich").Range("A" & zel. _
Row & ":J" & zel.Row).Resize(1, 8).Value
lz = lz + 1
End If
Next zel
End Sub
Danke