............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

Unir varios archivos Excel con el mismo formato en uno solo

Ver el tema anterior Ver el tema siguiente Ir abajo

Unir varios archivos Excel con el mismo formato en uno solo

Mensaje por mbass el Vie Ago 29, 2008 10:16 am

Hola,

Tengo varios archivos Excel con el mismo formato , es decir y cada uno tiene cuatro hojas, tambien iguales. Necesito consolidar todo en un solo archivo Excel.

1. Los nombres de los archivos deben ser iguales ?

Este es el nombre de los archivos, son alrededor de 50
Altas_SFS_20080101.xls
Altas_SFS_20071201.xls

Gracias de antemano

mbass

Cantidad de envíos: 3
Fecha de inscripción: 28/08/2008

Volver arriba Ir abajo

Re: Unir varios archivos Excel con el mismo formato en uno solo

Mensaje por GalileoGali el Sáb Ago 30, 2008 6:33 pm

DESCARGA ARCHIVO CONSOLIDADOR

Código:
Function ExistFile(Name As String) As Boolean
Dim strResult As String
Dim ruta As String
ruta = ThisWorkbook.Path & "\" & Name
strResult = Dir(ruta)
ExistFile = Not (strResult = vbNullString)

End Function
Sub copiarhoja(sh As Worksheet, wbk As Workbook)
Dim lngQtySh As Long

lngQtySh = wbk.Sheets.Count
sh.Copy After:=wbk.Sheets(lngQtySh)
   
End Sub

Sub consolidar()
Dim wbConsolidado As Workbook, wbEmisor As Workbook, wbOpn As Workbook
Dim strRuta As String, strFile As String
Dim shAux As Worksheet
Dim contador As Integer

ChDir ThisWorkbook.Path
strRuta = ThisWorkbook.Path & "\ALTAS_SFS*.xls"
For Each wbOpn In Workbooks
If wbOpn.Name Like "*ALTAS_SFS*" Then wbOpn.Close 1
Next wbOpn

If Not (ExistFile("ALTAS_SFS.xls")) Then
    strFile = Dir(strRuta, vbArchive)
    If strFile = vbNullString Then Exit Sub
    Name strFile As "ALTAS_SFS.xls"
Application.ScreenUpdating = False
strFile = Replace(Replace(strFile, "ALTAS_SFS_", ""), ".xls", "")
Workbooks.Open "ALTAS_SFS.xls"
    For Each shAux In ActiveWorkbook.Worksheets
        contador = contador + 1
        shAux.Name = strFile & " " & Chr(64 + contador)
    Next shAux
    Set shAux = Nothing
   
 ActiveWorkbook.Close 1
End If
Application.ScreenUpdating = False

Set wbConsolidado = Workbooks.Open("ALTAS_SFS.xls")
strFile = Dir(strRuta, vbArchive)
Do While strFile <> ""
    If strFile <> "ALTAS_SFS.xls" Then
    Set wbEmisor = Workbooks.Open(strFile)
    strFile = Replace(Replace(strFile, "ALTAS_SFS_", ""), ".xls", "")
    contador = 0
    For Each shAux In wbEmisor.Worksheets
    contador = contador + 1
    shAux.Name = strFile & " " & Chr(64 + contador)

    copiarhoja shAux, wbConsolidado
    Next shAux
    Set shAux = Nothing
    wbEmisor.Close 1
    End If
    strFile = Dir
Loop
wbConsolidado.Close 1

End Sub

Digamos que deberia funcionar ubicando este Archivo en la misma Carpeta (Directorio), en el que deberian estar ubicados los ALTAS_SFS_. La intencion es crear un archivo llamado "a secas" "ALTAS_SFS.xls", en el que se acumulen las hojas de los fechados. En el caso de que ya existiera este archivo, lo abrira y seguira cargando hojas (ojo con la cantidad de hojas
que estan limitadas por la Memoria disponible en el equipo).
hay inifinidad de variantes de hacer esto, de elegir o no el directorio de ubicacion de los sub-archivos, de Eliminar o no los archivos a medida que se los consolida...etc.
si no funciona, decí con precision en qué linea de codigo y qué mensaje devuelve VBA al correr....

_________________
GalileoGali
M.A.P. 2010-2013
Microsoft Active Professional

GalileoGali
Admin

Masculino Cantidad de envíos: 1962
Edad: 58
Ciudad - Pais: QUIROGA, Argentina
Version de Excel: 2000-2003-2007-2010
Fecha de inscripción: 24/01/2008

http://excelgali.mejorforo.net

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


Permisos de este foro:
No puedes responder a temas en este foro.