code to color cell
 

With the following code i wanted him to shadow me the cell that i
doesn't find with blue color but not you where to place the it lines
of code, I believe that it is placed after the function else i would
thank Them a lot them to help me

Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.FIND( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
"a").End(xlUp).Offset(2)
'Rellenar filas
For Filas = Worksheets("Automatizacion
A5,NB").Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub




Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.FIND( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
"a").End(xlUp).Offset(2)
'Rellenar filas
For Filas = Worksheets("Automatizacion
A5,NB").Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub

code to color cell
 

Sub testcolor()

Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
End If
' On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.Find( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then

Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3"). _
Cells(Rows.Count, "a").End(xlUp).Offset(2)
'Rellenar filas

For Filas = Worksheets("Automatizacion A5,NB"). _
Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3"). _
Cells(Rows.Count, 5).End(xlUp).Offset(3).Resize(8)
Next
Else
Worksheets("Automatizacion A5,NB").Range("bi" & Fila). _
Interior.ColorIndex = 5
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub



"Israel" wrote:



With the following code i wanted him to shadow me the cell that i
doesn't find with blue color but not you where to place the it lines
of code, I believe that it is placed after the function else i would
thank Them a lot them to help me

Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.FIND( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
"a").End(xlUp).Offset(2)
'Rellenar filas
For Filas = Worksheets("Automatizacion
A5,NB").Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub




Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.FIND( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
"a").End(xlUp).Offset(2)
'Rellenar filas
For Filas = Worksheets("Automatizacion
A5,NB").Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub