none
Consolidar datos en Excel mediante macros RRS feed

  • Pregunta

  • Hola a todos

    Necesito consolidar data de los archivos xlsx existentes en una carpeta, donde cada archivo cuenta con las mismas columnas.

    De tal forma que en el Libro donde cuente con la macro se genere una hoja con una tabla donde se halle toda la data de la suma de archivos e indicando en una columna adicional el nombre del archivo origen.

    Quisiera saber si esto es posible con VBA sin emplear ADO, si fuera asi por favor unas pautas pues en su defecto aplicare ADO.

    Gracias de antemano

    jueves, 15 de noviembre de 2012 16:46

Respuestas

Todas las respuestas

    • Marcado como respuesta M4rk00s miércoles, 21 de noviembre de 2012 14:46
    domingo, 18 de noviembre de 2012 16:08
  • Gracias por tu respuesta Rafa

    Tambien he creado una funcion para listar los archivos de un directorio y luego implrtar la data de estos.

    Function ListarArchivos(dia As Integer, anio As Integer) As String()
    Dim archivos() As String
    Dim buscar As String
    buscar = Format(dia, "00") & "-" & Format(anio, "0000")
    Dim ruta As String
    ruta = ActiveWorkbook.Path & "\CARPETA\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Carpeta = fso.GetFolder(ruta)
    Set ficheros = Carpeta.Files
    Dim index As Integer
    index = 0
    For Each archivo In ficheros
        If Mid(archivo.Name, 4, 7) = buscar Then
            ReDim Preserve archivos(index)
            archivos(index) = ruta & archivo.Name
            index = index + 1
        End If
    Next archivo
    Set fso = Nothing
    Set Carpeta = Nothing
    Set ficheros = Nothing
    Application.ScreenUpdating = True
    ListarArchivos = archivos
    End Function

    Sub Importar()
    Dim EXL As Excel.Application
    Set EXL = New Excel.Application
    Dim W As Excel.Workbook
    Set W = EXL.Workbooks.Open(ActiveWorkbook.Path & "\TRABAJO\12-10-2012.xlsx")
    Dim S As Excel.Worksheet
    Set S = W.Sheets("Hoja1")
    For i = 2 To 4
    For j = 1 To 5
    ActiveWorkbook.Sheets("Hoja1").Cells(i + 4, j) = S.Cells(i, j).Value
    Next j
    Next i

    Set S = Nothing
    'W.Save
    W.Close
    Set W = Nothing
    Set EXL = Nothing
    End Sub

    miércoles, 21 de noviembre de 2012 14:51