Macro para copiar filas de un libro a otro con condición

Tengo dos libros, libro1 y libro2, necesito extraer los ingresos del día laborable anterior que se encuentran en el libro2 copiar toda la fila y ponerlos en el libro1.

1

1 Respuesta

4.657.500 pts. Sancho, si los perros ladran ...

¿Y cómo identifico cuáles son los ingresos del día laborable anterior? ¿En qué columna los busco? ¿Y a partir de cuál fila quieres ponerlos en el libro1?

También me tienes que decir el nombre de las hojas origen y destino.

Saludos. DAM

Hola DAM,

La fecha de ingreso de los registros esta en la columna "c" del libro "Bitácora"

el libro en el que necesito ejecutar la maro se llama "Reporte diario" de aca abro el libro "Bitácora" que es en donde se encuentran todos los registros, busca los registros que se hayan realizado el día laborable anterior y los pega en la hoja "Reporte" a partir de la fila "A6" del libro "Reporte diario".

Digo el día laborable anterior porque si es dia lunes que ejecuto la macro, debe buscar los ingresos de día viernes, espero me haya explicado mejor.

Muchas gracias, Saludos.

Tengo este código pero no me anda bien no se porque solo me copia 1 registro:

Sub CompletarLibro()
Dim ruta As String, direccion1 As String
Dim celdadestino As Range
'definimos rutas y archivos como variables
ruta = "\\Administracion\red trabajo\registros\"
fichero1 = "BITACORA.xlsx"
direccion1 = ruta & fichero1
a = Range("B3")'Aqui pongo el nombre de la hoja a seleccionar
'identificamos la celda disponible en el archivo Principal, hoja Resumen
Set celdadestino = Workbooks("REPORTE DIARIO.xlsm").Sheets("Reporte").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'abrimos el fichero desde donde copiar... con el método .Open
Workbooks.Open Filename:=direccion1
Worksheets(a).Activate
'seleccionamos qué copiar y donde
For Each celda In Range("c1:c2000")
If celda.Value = (Date -1) Then
celda.EntireRow.Copy _
Destination:=Workbooks("REPORTE DIARIO.xlsm").Sheets("Reporte").Range(celdadestino.Address)
End If
Next

Saludos,

Te regreso la macro corregida, ya te copia todos los registros del día anterior laborable.

Sub CompletarLibro()
'Mod.Por.DAM
Dim ruta As String, direccion1 As String
Dim celdadestino As Range
'definimos rutas y archivos como variables
    ruta = "\\Administracion\red trabajo\registros\"
    fichero1 = "BITACORA.xlsx"
    direccion1 = ruta & fichero1    
    a = Range("B3") 'Aqui pongo el nombre de la hoja a seleccionar
'identificamos la celda disponible en el archivo Principal, hoja Resumen
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Reporte")
    u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
'abrimos el fichero desde donde copiar... con el método .Open
    Workbooks.Open Filename:=direccion1
    Worksheets(a).Activate
'seleccionamos qué copiar y donde
    For Each celda In Range("c1:c" & Range("C" & Rows.Count).End(xlUp).Row)
        'determinar el día laborable anterior
        dia = Weekday(celda)
        n = 1
        Select Case dia
        Case 2: n = 3
        Case 1: n = 2
        End Select
        If celda.Value = (Date - n) Then
            celda.EntireRow.Copy h1.Range("A" & u)
            u = u + 1
        End If
    Next
End Sub

Hola Dante, acabo de probar pero no extrae ningún registro ni me da ningún error, le cambie la fecha en: If celda.Value = (Date - n) Then y me extrajo todos los datos, como le puedo solucionar eso??

Saludos.

Disculpa, te anexo la macro con la corrección.

Sub CompletarLibro()
'Mod.Por.DAM
'definimos rutas y archivos como variables     
    ruta = "\\Administracion\red trabajo\registros\"
    fich = "BITACORA.xlsx"
    a = Range("B3") 'Aqui pongo el nombre de la hoja a seleccionar
'identificamos la celda disponible en el archivo Principal, hoja Resumen
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Reporte")
    u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
'abrimos el fichero desde donde copiar... con el método .Open
    Workbooks.Open Filename:=ruta & fich
    Worksheets(a).Activate
'determinar el día laborable anterior
    Select Case Weekday(Date)
        Case 1: n = 2
        Case 2: n = 3
        Case Else: n = 1
    End Select
'seleccionamos qué copiar y donde
    For Each celda In Range("c1:c" & Range("C" & Rows.Count).End(xlUp).Row)
        If celda.Value = (Date - n) Then
            celda.EntireRow.Copy h1.Range("A" & u)
            u = u + 1
        End If
    Next
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas