Macro para copiar si cumple condición
Necesito ayuda para crear una macro que evalué la columna A de la Hoja1 si cumple una condición.
Si la condición se cumple (Si la celda inicia con "Suc."), que copie el contenido de esta celda hacia HOJA2, Celda A1).
Si la condición no se cumple (Si la celda no inicia con "Suc."), que baje una fila y evalúe nuevamente la condición en la nueva celda (HOJA 1, Celda A2). Si la condición se cumple que repita el procedimiento de copiar y pegar y que pegue debajo de la celada que A1; si no se cumple, que siga bajando y evaluando hasta que encuentre una celda vacía en la columna A.
Intenté hacer mi macro siguiendo un caso similar en el foro pero no me salió:
Sub Raudi()
Sheets("hoja1").Select
'obtiene la última fila con datos de la columna A
ufila = Range("A" & Rows.Count).End(xlUp).Row
'obtiene el número de columna que representa la letra A
col = Range("A1").Column
k = 1
For i = 1 To ufila ' recorre toda la columna hasta la última celda con datos
If Cells(i, col) = "Suc." Then
'copia a la hoja2 columna A el contenido de la hoja1 columna A
Sheets("hoja2").Range("A" & k) = Sheets("hoja1").Range("A" & i)
k = k + 1
End If
Next 'va al siguiente registro
Sheets("hoja2").Select
End Sub
1 Respuesta
Esta macro en vez de buscar uno a uno en las filas la palabra "Suc." lo que hace es filtrar todas aquellas filas que contengan dicha palabra, ya que las filtro las selecciona y hace un copiado hacia la hoja2
Sub filtrar_y_copiar()
valor = "Suc."
With Range("a2").CurrentRegion
.AutoFilter 1, "*" & valor & "*"
.Offset(1).Copy
With Sheets("hoja2").Range("a2")
filas = .CurrentRegion.Rows.Count
If filas = 1 Then .PasteSpecial
If filas > 1 Then .Rows(filas + 1).PasteSpecial
End With
.AutoFilter
End With
End Sub
