Cambiar Macro ya grabada para que realice nuevas funciones
Hace algún tiempo me ayudaron a crear una macro aquí.
La macro permite abrir una carpeta y seleccionar manualmente todos los archivos excel en formato (xls) Intente modificarlo pues ahora necesito que haga nuevas funciones:
Necesito que copie todas las primeras hojas de los archivos que seleccione
y las acomode pegando las tablas de manera seguida. Borrando los encabezados y copiando solo la información
que necesito. La primera tabla que se pegara debe mantener el encabezado: (Fecha doc, Material, Prc.neto, Cliente, Ship to)
Y las demás tablas solo se van incorporando en orden según la fecha del documento.
Esto ya lo hacia la macro, el detalle es que las columnas ya cambiarón de ubicación ahora deben quedar apartir de
B1, C1, D1, E1, F1.
Además quisiera que en la columna A1 Se pegara la fecha en la cual se creo el documento:
(Esta fecha viene en el encabezado que deseo borrar), y se autollene la misma fecha de creación de documento
en toda la columna correspondiente a la información de ese día. Anexo link y código https://drive.google.com/open?id=1uI2ozAQi5hb2Zk2xByEpmDCHUXu7i4Ri
Sub UNEBORNS()
Dim X As Variant
X = Application.GetOpenFilename _
("Excel Files (*.xls), *.xls", 2, "Abrir archivos", , True)
If IsArray(X) Then
Workbooks.Add
A = ActiveWorkbook.Name
Set DESTINO = Workbooks(A).Worksheets("HOJA1")
Z = 1
For Y = LBound(X) To UBound(X)
Application.StatusBar = "Importando Archivos: " & X(Y)
Workbooks.Open X(Y)
B = ActiveWorkbook.Name
For Each Hoja In Worksheets
F = 0: C = 0
Set DATOS = Workbooks(B).Worksheets(Hoja.Name).UsedRange
Selection.SpecialCells(xlCellTypeLastCell).Select
Set DATOS = Selection.CurrentRegion
F = DATOS.Rows.Count: C = DATOS.Columns.Count
If F = 1 Then GoTo SIGUIENTE
If Z = 1 Then
Set DESTINO = DESTINO.Range("B2").Resize(F, C)
Else
Set DATOS = DATOS.Rows(2).Resize(F - 1, C)
Set DESTINO = DESTINO.Rows(DESTINO.Rows.Count + 1).Resize(F - 1, C)
End If
DESTINO.Value = DATOS.Value
Workbooks(B).Close False
Z = Z + 1
SIGUIENTE:
Next Hoja
Next Y
End If
End Sub