Salvo el poner en orden los datos después del proceso eata sería la macro que hace lo que pides:
Sub BuscarRechazados()
'By ValeroASM
Dim i, j, k, ulfila, LugarInsercion As Integer
Dim c As Range
Dim HuboCambios As Boolean
Application.ScreenUpdating = False
LugarInsercion = 2
Worksheets("Hoja2").Activate
ulfila = Range("B" & Rows.Count).End(xlUp).Row
Range("a2:j" & ulfila).Interior.Color = vbWhite
i = 2
While i <= ulfila
HuboCambios = False
Set c = Worksheets("Hoja1").Range("B:B").Find(Cells(i, "B"))
If Not c Is Nothing Then
j = c.Row
For k = 3 To 10
If UCase(Cells(i, k)) = "RECHAZADO" And _
UCase(Worksheets("Hoja1").Cells(j, k)) <> "RECHAZADO" Then
HuboCambios = True
Cells(i, k).Interior.Color = vbRed
End If
Next
Else
For k = 3 To 10
If UCase(Cells(i, k)) = "RECHAZADO" Then
HuboCambios = True
Cells(i, k).Interior.Color = vbRed
End If
Next
End If
If HuboCambios Then
If LugarInsercion <> i Then
Rows(LugarInsercion).Insert Shift:=xlDown
If LugarInsercion = 2 Then
Rows("4:4").Select
Selection.Copy
Rows("2:2").Select
Selection.PasteSpecial Paste:=xlPasteFormats
End If
Rows(LugarInsercion).Borders(xlEdgeBottom).TintAndShade = 0
Rows(i + 1).Select
Selection.Copy
Rows(LugarInsercion).Select
ActiveSheet.Paste
Rows(i + 1).Delete Shift:=xlUp
End If
LugarInsercion = LugarInsercion + 1
End If
i = i + 1
Wend
Application.ScreenUpdating = True
Application.CutCopyMode = False
Range("a1").Select
End Sub
Si me dices que la columna B va a estar siempre en orden esta macro te devolvera los rojos al principio en orden y los no rojos debajo también en orden y ya estaría.
Si me dices que no están en orden pero da lo mismo que no queden en orden también sirve así.
Si me dices que no están en orden pero te gustarían en orden es cuando habría que ordenar rojos y no rojos por separado al final.
·
Ahora te mando el fichero para que la pruebes. Va con una nueva Hoja3 que es copia de Hoja2 y la usaba para deshacer inmediatamente los cambios tras las pruebas.