Macro to copy exactly the I number of times that he/she appears in the column

[Israel]

hi
i have a problem with this codigo

I want to copy exactly the I number of times that AV appears in the
column but I have not achieved it, they could also check since the
code it is the I finish that I lack it of my work, and appears me an
error in ELSE and not you if to remove or to put is beginner in Visual
basic
i would thank them they to help me

Sub Botón437_AlHacerClic()
Dim Origen As Range, Fila As Integer, Veces As Byte, Filas As Long
Fila = 8
Busca:
If Worksheets("Automatizacion A5,NB").Range("bh" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.Find( _
What:=Worksheets("Automatizacion A5,NB").Range("a" & Fila), _
After:=.Range("bh3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
For Veces = 1 To Worksheets("Automatizacion A5,NB").Range("av" &
Fila)
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, 61).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else: MsgBox Worksheets("Automatizacion
A5,NB").Range("a" & Fila) & " NO se encuentra !!!"
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing

end sub



Thanks

 

[Jay]

Hi Israel -

Here is a starting point. Errors are eliminated, but I can't tell whether
this will do what you intend. Test it and let me know. I'll be offline for
8 hours starting at 3am PST (USA).

Sub Botón437_AlHacerClic()
Dim Origen As Range, Fila As Integer, Veces As Byte, Filas As Long
Fila = 8
Busca:
If Worksheets("Automatizacion A5,NB").Range("bh" & Fila) = "" Then GoTo
Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.Find( _
What:=Worksheets("Automatizacion A5,NB").Range("a" & Fila), _
After:=.Range("bh3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
For Veces = 1 To Worksheets("Automatizacion A5,NB").Range("av" &
Fila).Value
Origen.Resize(9, 1).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
1).End(xlUp).Offset(2, 0)
'Rellenar filas
For Filas = Worksheets("Automatizacion A5,NB").Cells(Rows.Count,
1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Filas, 61).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count, 5) _
.End(xlUp).Offset(3, 0).Resize(8, 1)
Next Filas
Next Veces
Else: MsgBox Worksheets("Automatizacion A5,NB").Range("a" & Fila) & _
" NO se encuentra !!!"
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing

End Sub