Copiar filas

[Miguelsp]

Hola amigos

Hace tiempo que no entraba porque cambié de trabajo así que primero de todo quería saludaros a todos.

Tengo una duda, a ver si me podéis ayudar. Podría empezar por estructurar mejor mis ficheros, lo se... pero es la manera que lo tienen en esta empresa

Imaginad.

Hay una carpeta con unos 1500 archivos excel. Muy pequeños, en total unas 32 Mb. Son fichas con bastante información interna. La información que se puede mandar a los clientes está en las filas 1, 2 y 3

Quieren que haga un archivo que coja las tres primeras filas de cada uno de los ficheros y las consolide (las pegue) en un único fichero para poder compartirlo con los clientes.

Yo he pensado varias maneras a cuada cual más absurda...

a) Abrir 1500 archivos y copiar y pegar uno a uno god!!
b) Copiar el código

Windows("Ficha 1.xls").Activate
Rows("1:3").Select
Selection.Copy
Windows("Stockage.xls").Activate
Rows("1:1").Select
ActiveSheet.Paste

1500 veces cambiando Windows("Ficha 1.xls").Activate y Rows("1:1").Select otrras 1500 veces

c) la más sensata, venir aquí a ver si alguno me puede ayudar

alguna sugerencia? Puedo escribir en una lista los nombres de los archivos y que me lo vaya cogiendo de ahí?

gracias por anticipado y un saludo

Miguel

 

[Greg Truby]

¿Cuál versión de Excel? ¿Los 1.500 archivos son los únicos en tal carpeta (estoy interpretando «carpeta» como «directorio») o hay otros archivos dentro de esta carpeta también? ¿Si hay otros, habrá algo en común de los nombres de los archivos para poder filtrarlos?

 

[Miguelsp]

Hola Greg

Gracias por el interés.

Por "carpeta" me refiero a un "folder" si así te es más comprensible.

Es una carpeta en la que no hay nada más que los archivos que necesito y la versión que tengo de office es XP.

Me parece que ya tienes una idea, verdad?

muchas gracias

Miguel

 

[Greg Truby]

Las tres 1ªs líneas de cada archivo - ¿una tras otra en la misma hoja? ¿Es decir el resultado es una hoja con 4.500 ringlones? ¿O cada una en una hoja separada -- un cuaderno con 1.500 hojas?

 

[Miguelsp]

Lo que me gustaría es una hoja con 4500 filas (rows).

 

[Greg Truby]

Miguel,

Estaba seguro que habrá un post acerca de esta tema porque es una actividad que sería bastante común. Y así fue. Adapté algo que escribió Richie(UK) hace poco. Espero que le ayude. Yo lo probé y parece que me funcionó bien. Háganos saber si se queda con otra pregunta o duda.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> AbriryCopiar()
<SPAN style="color:#007F00">' adapted from code posted by Richie(UK)</SPAN>
<SPAN style="color:#007F00">' http://www.mrexcel.com/board2/viewtopic.php?t=112346</SPAN>
    
    <SPAN style="color:#007F00">' La carpeta con los archivos para abrir.</SPAN>
    <SPAN style="color:#00007F">Const</SPAN> strSendero <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "D:\Shipping"
    
    <SPAN style="color:#00007F">Dim</SPAN> varArchivo <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, i%
    <SPAN style="color:#00007F">Dim</SPAN> fs <SPAN style="color:#00007F">As</SPAN> FileSearch
    
    <SPAN style="color:#00007F">Set</SPAN> fs = Application.FileSearch
    
    <SPAN style="color:#007F00">' Cambie la hilera "xxx*.xls" para que sea una</SPAN>
    <SPAN style="color:#007F00">' mascara que devolverá los archivos deseados.</SPAN>
    <SPAN style="color:#007F00">' Si desea todos, borre la línea.</SPAN>
    <SPAN style="color:#00007F">With</SPAN> fs
        .NewSearch
        .LookIn = strSendero
        .SearchSubFolders = <SPAN style="color:#00007F">False</SPAN>
        <SPAN style="color:#007F00">'.FileType = msoFileTypeExcelWorkbooks</SPAN>
        .Filename = "dhl*.xls"
        <SPAN style="color:#00007F">If</SPAN> .Execute > 0 <SPAN style="color:#00007F">Then</SPAN>
            Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
            <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> varArchivo <SPAN style="color:#00007F">In</SPAN> .FoundFiles
                i = i + 1
                Application.StatusBar = "Procesando archivo: " & varArchivo & _
                                        "  (" & i & " de " & .FoundFiles.Count & " )"
                CopyData varArchivo
            <SPAN style="color:#00007F">Next</SPAN>
        <SPAN style="color:#00007F">Else</SPAN>
            MsgBox "Ningún archivo encontrado."
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
        Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">Sub</SPAN> CopyData(<SPAN style="color:#00007F">ByVal</SPAN> strArchivo <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>)

    <SPAN style="color:#00007F">Dim</SPAN> wbData <SPAN style="color:#00007F">As</SPAN> Workbook, wsData <SPAN style="color:#00007F">As</SPAN> Worksheet, wsDest <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> rngFuente <SPAN style="color:#00007F">As</SPAN> Range, rngDest <SPAN style="color:#00007F">As</SPAN> Range
    
    <SPAN style="color:#00007F">Set</SPAN> wbData = Workbooks.Open(Filename:=strArchivo)
    <SPAN style="color:#00007F">Set</SPAN> wsData = wbData.Worksheets(1)
    <SPAN style="color:#00007F">Set</SPAN> wsDest = ThisWorkbook.Worksheets(1)
    <SPAN style="color:#00007F">Set</SPAN> rngDest = wsDest.Range("A65536").End(xlUp).Offset(1)
    <SPAN style="color:#00007F">If</SPAN> rngDest.Address = "$A$2" And wsDest.[A1].Formula = "" <SPAN style="color:#00007F">Then</SPAN>
        <SPAN style="color:#00007F">Set</SPAN> rngDest = rngDest.Offset(-1)
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> rngFuente = wsData.Range("A1:IV3")
    
    rngFuente.Copy rngDest
    wbData.Close SaveChanges:=<SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Saludos,

 

[Greg Truby]

Uy, se me olvidó - agregue una línea al fin de AbriryCopiar como

Application.StatusBar = False

para poner el StatusBar otra vez a un estado normal después de haber procesado el último archivo.

 

[Miguelsp]

ray:

Una vez más me he quedado sin palabras.... Solo sale un GRACIAS!!!

Funcionó perfectamente.

Esta macro es muy interesante porque facilita compartir información con clientes sin tener que copiar / pegar. Creo que es puede ser muy util para los amigos del board.

La otra opción que comentabas (una hoja por archivo) también puede ser de gran utilidad para, por ejemplo, un equipo de Recursos Humanos que tiene que consoidar datos de sus empleados.

Gracias de nuevo

Miguel