Macro VBA copia registro dependiendo de criterios


 Procedimiento de VBA para Excel, me preguntaron como se podía hacer para exportar datos de una hoja a otra, donde sólo se debían copiar ciertos datos y que cumplan varios criterios; bien eso es lo que hace este ejemplo mediante una Macro. Primero determina si los registros que se encuentran en la fila analizada se deben o no exportar, en caso afirmativo revisa si los datos de determinadas columnas cumplen un requisito, en caso positivo se copia esa columna, en caso negativo otra columna distinta, a su vez copia otra serie de registros que sólo dependen del primer criterio; haz click en el link del final para bajar el ejemplo. Te recomiendo que leas un excelente libro sobre Excel para ello haz click acá. El código que se encuentra a continuación se debe ingresar en un módulo, descargando el ejemplo lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.


Código a insertar en módulo


Sub exporta()
Application.ScreenUpdating = False
On Error Resume Next
Dim filaex, filaim, conta As Integer
filaex = 6
filaim = 2
conta = 0
While Sheets("Libro").Cells(filaex, 1) <> Empty
    If Sheets("Libro").Cells(filaex, 27) = "SI" Then
        Sheets("Caja Diaria").Cells(filaim, 1) = Sheets("Libro").Cells(filaex, 1)
        Sheets("Caja Diaria").Cells(filaim, 2) = Sheets("Libro").Cells(filaex, 2)
        Sheets("Caja Diaria").Cells(filaim, 3) = Sheets("Libro").Cells(filaex, 3)
        Sheets("Caja Diaria").Cells(filaim, 4) = Sheets("Libro").Cells(filaex, 6)
       
          If Sheets("Libro").Cells(filaex, 7) > 0 Then
                Sheets("Caja Diaria").Cells(filaim, 5) = Sheets("Libro").Cells(filaex, 7)
          Else
                Sheets("Caja Diaria").Cells(filaim, 5) = Sheets("Libro").Cells(filaex, 23)
          End If
         
          If Sheets("Libro").Cells(filaex, 8) > 0 Then
                Sheets("Caja Diaria").Cells(filaim, 6) = Sheets("Libro").Cells(filaex, 8)
          Else
                Sheets("Caja Diaria").Cells(filaim, 6) = Sheets("Libro").Cells(filaex, 24)
          End If
    conta = conta + 1
    filaim = filaim + 1
    End If
filaex = filaex + 1
Wend
MsgBox ("Se exportaron con éxito " & conta & " registros"), vbInformation
Application.ScreenUpdating = False
End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.




If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends