Cómo puedo copiar datos de 8 libros distintos a 32 plantillas, utilizando un filtro para pegar los datos que corresponden
Necesito copiar de 8 libros origen información que se filtra por entidad, a 32 plantillas que contienen 8 pestañas cada uno, cada uno de esos 32 tiene la misma estructura.
1 respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro para copiar:
Sub ProcesarInformacion()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
Set h12 = l1.Sheets(2)
'
'variables
ruta = l1.Path & "\"
vigen = "VIGENTES"
'Lipiar hoja
u = h1.Range("A" & Rows.Count).End(xlUp).Row
If u < 3 Then u = 3
uc = h1. Cells(2, h1. Columns. Count).End(xlToLeft). Column
h1. Range(h1.Cells(3, "B"), h1. Cells(u, uc)). ClearContents
'
For i = 3 To u
msj1 = ""
arch = h1.Cells(i, "A") & ".xlsx"
hoja = h12.Cells(i, "B")
borr = h12.Cells(i, "C")
cole = h12.Cells(i, "D") 'columna estado
colp = h12.Cells(i, "E") 'columnas copiar
If arch = "" Then msj1 = "Falta poner el nombre del libro (8)"
If hoja = "" Then msj1 = "Falta configurar la hoja"
If borr = "" Then msj1 = "Falta configurar el estado de borrar"
If cole = "" Then msj1 = "Falta configurar la columna estado"
If colp = "" Then msj1 = "Falta configurar las columnas copiar"
If Dir(ruta & arch) = "" Then msj1 = "No existe archivo"
'
Application.StatusBar = "Leyendo archivo: " & arch & "."
If msj1 = "" Then
Set l2 = Workbooks.Open(ruta & arch, , True)
If ExisteHoja(l2, vigen) Then
Procesamiento l2, vigen, h1, i, ruta, arch, hoja, borr, cole, colp
Else
msj1 = "No existe hoja Vigentes"
End If
l2.Close
Set l2 = Nothing
End If
'Actualizar estatus
h1.Cells(i, "B") = Now
h1.Cells(i, "C") = msj1
Next
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub':) ':)
