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
>
>
|
Similar Threads
