Jump to content

Copiar filas a dos hojas


JSDJSD

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

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

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

Link to post
Share on other sites

Archived

This topic is now archived and is closed to further replies.

Guest
This topic is now closed to further replies.


×
×
  • Create New...

Important Information

Privacy Policy