Jump to content
  • Debido a la crisis sanitaria, hasta el día 31 de marzo, el registro al foro de Ayuda Excel será totalmente gratuito para facilitar el teletrabajo. Todos los registros que se produzcan entre estas fechas tendrán acceso gratuito ilimitado a la comunidad hasta el 30 de abril.

    Regístrate

    Si te surge alguna duda mientras estás trabajando en casa con Excel, ya tienes a quien preguntar.

    Espero que esta medida te sirva de ayuda. Frenar la expansión del coronavirus depende de todos. Sé responsable.

JSDJSD

Copiar filas a dos hojas

Recommended Posts

El proposito es que cuando pulsemos el boton (Cobrado) pase a la Hoja2 y Hoja3 las filas en cuya columna F tenga valor borrandolas al mismo tiempo de la hoja1, así como también pase a
la Hoja2 y Hoja3 las filas en cuya columna H tengan algún valor pero sin borrar la línea de la Hoja1 pero que si quite el valor de la Columna H una vez pasado a las Hojas 2 y 3.
Hay que tener en cuenta que el número de filas es indeterminado y que no siempre tiene porque haber valores en la columna F y en la columna H, ya que puede darse el caso de que solo haya en la Columna F o solo en la Columna H o en las dos.

Prueba.xlsb

Share this post


Link to post
Share on other sites

Sub Cobrado2()

Application.ScreenUpdating = False
Dim vunir As Range

    
    
For Each cel In Range("C2", Range("C1").End(xlDown))
    fil = cel.Row: vsum = Cells(fil, "F") + Cells(fil, "G")
    If cel = vsum Then
        If vunir Is Nothing Then
            Set vunir = cel
        Else
            Set vunir = Union(vunir, cel)
        End If
    End If
Next
vuf = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
vuf1 = Hoja3.Range("A" & Rows.Count).End(xlUp).Row + 1
vunir.EntireRow.Copy Hoja2.Range("A" & vuf)
vunir.EntireRow.Copy Hoja3.Range("A" & vuf1)
vunir.EntireRow.Delete

Set vunir = Nothing
Application.ScreenUpdating = True


End Sub

Share this post


Link to post
Share on other sites

Sub EntregaCuenta()
Application.ScreenUpdating = False
For Each cel In Range("C2", Range("C1").End(xlDown))

    fil = cel.Row: vsum = Cells(fil, "H")
    If vsum > 0 Then
        vuf = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
        cel.EntireRow.Copy Hoja2.Range("A" & vuf)
        cel.EntireRow.Copy Hoja3.Range("A" & vuf)
        'Cel.EntireRow.Delete
    End If
Next
Range("H2:I1000").ClearContents
Application.ScreenUpdating = True
End Sub

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png