Macro que no se detenga si el valor de la celda no es igual

Espero puedan ayudarme, estoy intentando hacer una macro pero como se casi nada de macros no me queda, expongo mi caso:

Tengo 5 sucursales, Agencia, Campestre, Satelite, Santa Fe y CDMX

En una hoja busco por ejemplo la palabra "campestre", una vez que la encuentra quiero que la copie y la pegue en un lado que le indico, en caso de que no encuentre quiero que siga su proceso normal que es buscar la siguiente sucursal pero ya me atore.

Aquí dejo parte del código esperando me ayuden:

'aquí busco la sucursal agencia,
Application.CutCopyMode = False
Cells.Find(What:="agencia", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Application.CutCopyMode = False

' Si la celda activa es igual a la sucursal "agencia debe copiar y pegar, si no es igual 'debe seguir su camino buscando la sigiente sucursal, esto debe hacerse en cada sucursal ya que es posible que en alguna no tenga datos en algún día.
If ActiveCell.Select = "AGENCIA" Then
Selection.Copy
ActiveCell.Offset(-1, -3).Select
ActiveSheet.Paste
End If
'SUCURSAL CAMPESTRE
Application.CutCopyMode = False
Cells.Find(What:="campestre", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, -3).Select
ActiveSheet.Paste
'SUCURSAL SATELITE
Cells.Find(What:="doctores", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, -3).Select
ActiveSheet.Paste
'SUCURSAL SANTA FE
Cells.Find(What:="garcia gineres", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, -3).Select
ActiveSheet. Paste

1 Respuesta

Respuesta
1

Es necesario más información:

Que estructura tiene tu tabla

¿Qué es lo que deseas copiar cuando se cumpla la condición que es tu caso son las sucursales?

Donde lo copiara, ¿en otra hoja?

¿Cuántos datos puede haber por sucursal?

Gracias por tu respuesta, te explico:

Es una tabla con tres columnas y "N" cantidad de filas, en cualquier fila puede estar el nombre de las sucursales,, en la columna "C" están los datos, busco por ejemplo la palabra "campestre", una vez la encuentra copia el contenido de esa celda y lo pone en la misma hoja con esta instrucción 

Selection.Copy "COPIA LA CELDA"
ActiveCell.Offset(0, -3).Select "RECORRE TRES CELDAS A LA IZQUIERDA
ActiveSheet.Paste " PEGA EL CONTENIDO DE LA CELDA

Espero darme a entender.

Estimado Mauricio, 

Encontré mi error, esto es lo que requería

On Error Resume Next
Cells.Find(What:="agencia", After:=ActiveCell, LookIn:= _
xlValues, lookat:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
xlNext, MatchCase:=False).Activate

On Error Resume Next
Cells.Find(What:="agencia", After:=ActiveCell, LookIn:= _
xlValues, lookat:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
xlNext, MatchCase:=False).Activate
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(-1, -3).Select
ActiveSheet.Paste

Muchas gracias por tu tiempo

Muy bien, tradicionalmente de coloco el siguiente código para realizar lo mismo, saludos.

Sub Busca_copia()
Dim UltFila, I As Integer
UltFila = Range("C" & Rows.Count).End(xlUp).Row
For I = 1 To UltFila
If UCase(Cells(I, 3).Value) Like "*CAMPESTRE*" Then Cells(I, 1) = Cells(I, 3).Value
If UCase(Cells(I, 3).Value) Like "*SATELITE*" Then Cells(I, 1) = Cells(I, 3).Value
If UCase(Cells(I, 3).Value) Like "*SANTA FE*" Then Cells(I, 1) = Cells(I, 3).Value
Next I
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas