Tengo 32 archivos con la misma estructura y mismas hojas (8) como puedo realizar el borrado de cada hoja.

Que tal tengo 32 archivos en Excel con 8 hojas cada uno, cada hoja tiene la misma estructura, quiero realizar el borrado de la información que contiene cada hoja (excepto 2), para los 32 archivos.

1

1 Respuesta

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

H o l a Lau:

Empiezo con la preparación de la macro y te la envío para que la pruebes.

Sal u dos

H o l a:

Te anexo la parte para borrar el borrado de información de cada hoja de los 32 archivos.

Sub ProcesarInformacion()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    '
    'variables
    ruta = l1.Path & "\"
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    If u < 3 Then u = 3
    h1.Range("C3:AJ" & u).ClearContents
    vigen = "VIGENTES"
    '
    For i = 3 To u
        msj1 = ""
        arch = h1.Cells(i, "A") & ".xlsx"
        hoja = h1.Cells(i, "B")
        Application.StatusBar = "Leyendo archivo: " & arch & "."
        If Dir(ruta & arch) = "" Then
            msj1 = "No existe archivo"
        Else
            Set l2 = Workbooks.Open(ruta & arch, , True)
            If ExisteHoja(l2, vigen) Then
                Procesamiento l2, vigen, h1, i, ruta, arch, hoja
            Else
                msj1 = "No existe hoja Vigentes"
            End If
            l2.Close
            Set l2 = Nothing
        End If
        'Actualizar estatus
        h1.Cells(i, "C") = Now
        h1.Cells(i, "D") = msj1
    Next
    Application.StatusBar = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub
'
Sub Procesamiento(l2, vigen, h1, i, ruta, arch, hoja)
'Por.Dante Amor
    Set h2 = l2.Sheets(vigen)
    For j = h1.Columns("E").Column To h1.Columns("AJ").Column
        msj2 = ""
        estado = "s" & h1.Cells(2, j)
        archestado = Dir(ruta & estado & "*.xlsx")
        Application.StatusBar = "Leyendo archivo: " & arch & ". Actualizando estado: " & estado
        If archestado = "" Then
            msj2 = "No existe archivo"
        Else
            Set l3 = Workbooks.Open(ruta & archestado)
            If ExisteHoja(l3, UCase(hoja)) Then
                Set h3 = l3.Sheets(hoja)
                fila = 10
                Do While h3.Cells(fila, "B") <> ""
                    fila = fila + 1
                Loop
                h3.Rows("10:" & fila - 1).Delete
                msj2 = "Procesado"
            Else
                msj2 = "No existe hoja"
            End If
            l3.Close True
        End If
        h1.Cells(i, j) = msj2
    Next
End Sub
'
Function ExisteHoja(Obj, hoja)
    ExisteHoja = False
    'Veirifica
    For Each h In Obj.Sheets
        If UCase(h.Name) = hoja Then
            ExisteHoja = True
            Exit For
        End If
    Next
End Function

':)
'S aludos. D a n t e   A m o r . R ecuerda valorar la respuesta. G racias
':)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas