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

1 Respuesta

Respuesta
1

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas