Macro para copiar datos a otra hoja

Soy un novato en el mundo de hacer "macros".

Necesito una macro (con botón) para que al apretarlo me traspase a un NUEVO LIBRO, los datos que digan "true" según una fórmula que tengo.

Gracias!

1 respuesta

Respuesta
2

Te anexo la macro, cambia la "B" en la línea col = "B" por la columna donde tengas TRUE o FALSE

Sub Copiar_Filas()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    Set l2 = Workbooks.Add
    Set h2 = l2.Sheets(1)
    col = "B"
    '
    h1.Rows(1).Copy h2.Rows(1)
    j = 2
    Set r = h1.Columns(col)
    Set b = r.Find("TRUE", LookAt:=xlWhole, LookIn:=xlValues)
    If Not b Is Nothing Then
        celda = b.Address
        Do
            'detalle
            h1.Rows(b.Row).Copy h2.Rows(j)
            j = j + 1
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    End If
    MsgBox "Fin"
End Sub

Sigue las Instrucciones para un botón y ejecutar la macro

  1. Abre tu libro de Excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. En el menú elige Insertar / Módulo
  4. En el panel del lado derecho copia la macro
  5. Ahora para crear un botón, puedes hacer lo siguiente:
  6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
  7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
  8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
  9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: Copiar_Filas
  10. Aceptar.
  11. Para ejecutarla dale click a la imagen.

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Esta perfecto, pero....

Que hay que modificar para que solo copie las columnas "A" y "B", ya que copia el contenido de toda la hoja.

Gracias!!

Cambia esta línea

H1. Rows(b. Row). Copy h2. Rows(j)

Por esta

H1.range("A" & b.Row & ":B" & b. Row). Copy h2. Range("A" & j)

No olvides valorar la respuesta

Hola, sigue copiando toda la hoja, te adjunto todo el código.

Sub Copiar_Filas()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set H1 = l1.ActiveSheet
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
col = "B"
'
H1.Rows(1).Copy h2.Rows(1)
j = 2
Set r = H1.Columns(col)
Set b = r.Find("NO", LookAt:=xlWhole, LookIn:=xlValues)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
H1.Range("A" & b.Row & ":B" & b.Row).Copy h2.Range("A" & j)
j = j + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
MsgBox "Clientes sin Activos"
End Sub

En esta macro solamente eliminé la copia del encabezado

Revisa ejecutar la nueva macro

Sub Copiar_Filas()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    Set l2 = Workbooks.Add
    Set h2 = l2.Sheets(1)
    col = "B"
    '
    j = 2
    Set r = h1.Columns(col)
    Set b = r.Find("TRUE", LookAt:=xlWhole, LookIn:=xlValues)
    If Not b Is Nothing Then
        celda = b.Address
        Do
            'detalle
            h1.Range("A" & b.Row & ":B" & b.Row).Copy h2.Range("A" & j)
            j = j + 1
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    End If
    MsgBox "Fin"
End Sub

No olvides valorar la respuesta!!!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas