Actualizar base de datos - macro

Dante,

Tengo 3 archivos excel donde cargo datos (los 3 igual pero utilizados por personas distintas) y una base de datos de respaldo con el resumen de su trabajo.

Necesito una macro que me actualice la BD sin borrar la info previamente guardada... Para ello debe verificar si la BD tiene informacion en esa celda, en el caso que si, que mo haga nada, en el caso que no, busque info en los excel de los operarios y si hay información que la actualice

¿Se puede hacer?

1 Respuesta

Respuesta
1

Te anexo la macro

Sub Actualizar()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    '
    ruta = l1.Path & "\"
    arch = Dir(ruta & "*.xls*")
    Do While arch <> ""
        If arch <> l1.Name Then
            Set l2 = Workbooks.Open(ruta & arch, ReadOnly:=True)
            Set h2 = l2.Sheets(1)
            For i = 9 To h2.Range("A" & Rows.Count).End(xlUp).Row
                If h2.Cells(i, "B") <> "" Then
                    Set b = h1.Columns("A").Find(h2.Cells(i, "A"), lookat:=xlWhole)
                    If Not b Is Nothing Then
                        'h2.Range("B" & i & ":CC" & i).Copy h1.Cells(b.Row, "B")
                        For j = Columns("B").Column To Columns("CC").Column
                            If h1.Cells(i, j) = "" Then
                                h1.Cells(i, j) = h2.Cells(b.Row, j)
                            End If
                        Next
                    Else
                        u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
                        h2.Range("B" & i & ":CC" & i).Copy h1.Cells(u1, "B")
                    End If
                End If
            Next
            l2.Close
        End If
        arch = Dir()
    Loop
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
    With h1.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A9:A" & u1), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
        .SetRange Range("A8:CC" & u1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas