Jump to content
Jose BN

ANSWERED Copiar datos de una hoja a otra si el valor es mayor a 0

Recommended Posts

Buenos días!

 

Amigos del foro quisiera solicitarles el apoyo para resolver el siguiente problema, necesito una macro que me permita copiar de una hoja a otra si se cumplen los siguientes criterios:

  • Si el valor en la columna G de la hoja Diario es mayor que cero, se copien los datos de Diario(hasta la ultima celda con datos) a la hoja BD pegando los datos en la ultima celda vacía de BD.
  • Al copiar aquellos valores mayores a cero en la hoja BD quitarlos de la hoja Diario, solamente dejando los datos que contengan cero o se encuentren vacios en la columna G de la hoja Diario.

Lo estuve intentando de la siguiente manera:

Sub copiar2()

    Set J1 = Sheets("Diario")
    Set J2 = Sheets("BD")
    j = J2.Range("A" & Rows.Count).End(xlUp).Row + 1
    For i = 3 To 79
        If J1.Cells(i, "G") > 0 Then
            J2.Cells(i, "A") = J1.Cells(i, "A")
            J2.Cells(i, "B") = J1.Cells(i, "B")
            J2.Cells(i, "C") = J1.Cells(i, "C")
            J2.Cells(i, "D") = J1.Cells(i, "D")
            J2.Cells(i, "E") = J1.Cells(i, "E")
            J2.Cells(i, "F") = J1.Cells(i, "F")
            J2.Cells(i, "G") = J1.Cells(i, "G")
            J2.Cells(i, "H") = J1.Cells(i, "H")
            J2.Cells(i, "I") = J1.Cells(i, "I")
            J2.Cells(i, "J") = J1.Cells(i, "J")
            J2.Cells(i, "K") = J1.Cells(i, "K")
            J2.Cells(i, "L") = J1.Cells(i, "L")
            J2.Cells(i, "M") = J1.Cells(i, "M")
            J2.Cells(i, "N") = J1.Cells(i, "N")
        End If
    Next
    MsgBox "Valores copiados"
End Sub

Saludos

JB

Consulta copiado.xlsm

Share this post


Link to post
Share on other sites

Checa el archivo:

Sub Copia()
Application.ScreenUpdating = False
Dim Uf As String
Dim Ul As Long

    Ul = Hoja2.Range("G" & Rows.Count).End(xlUp).Row + 2
            Uf = Hoja1.Range("G" & Rows.Count).End(xlUp).Row
                Hoja1.Range("A2:N" & Uf).AutoFilter Field:=7, Criteria1:=">0"
                    Hoja1.Range("A3:N10000").SpecialCells(xlCellTypeVisible).Copy Destination:=Hoja2.Cells(Ul, 1)

Hoja1.Range("A3:N" & Uf).EntireRow.Delete
Hoja1.Range("A2:N" & Uf).AutoFilter

Application.ScreenUpdating = True
End Sub

 

Copia de Consulta copiado.xlsm

Share this post


Link to post
Share on other sites
Hace 56 minutos , DiegoLG dijo:

Checa el archivo:


Sub Copia()
Application.ScreenUpdating = False
Dim Uf As String
Dim Ul As Long

    Ul = Hoja2.Range("G" & Rows.Count).End(xlUp).Row + 2
            Uf = Hoja1.Range("G" & Rows.Count).End(xlUp).Row
                Hoja1.Range("A2:N" & Uf).AutoFilter Field:=7, Criteria1:=">0"
                    Hoja1.Range("A3:N10000").SpecialCells(xlCellTypeVisible).Copy Destination:=Hoja2.Cells(Ul, 1)

Hoja1.Range("A3:N" & Uf).EntireRow.Delete
Hoja1.Range("A2:N" & Uf).AutoFilter

Application.ScreenUpdating = True
End Sub

Diego igual muchas gracias! 

Copia de Consulta copiado.xlsm 39.44 kB · 2 descargas

 

Share this post


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

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.




×
×
  • Create New...

Important Information

Privacy Policy