Macro que extraiga datos de varias hojas que se encuentran en varios archivo.

Me pueden ayudar por favor con una macro que extraiga datos de una misma hoja que se encuentra en varios archivos. Necesito extraer de 800 archivos excel, de una hoja que tiene el mismo nombre en todos los archivos, una misma columna.

1 respuesta

Respuesta
2

Te anexo la macro, el archivo con la macro deberás ponerlo en la misma carpeta donde tienes los otros archivos.

La macro te va a copiar las columnas en la hoja 1.
Cambia en la macro estas líneas, por el nombre de la hoja y por la columna que quieres copiar
hoja = "Hoja1"
col = "B"

Sigue las Instrucciones para modificar la macro
1. Abre el archivo que te estoy enviando
2. Para abrir Vba-macros y poder modificar la macro, Presiona Alt + F11

https://www.dropbox.com/s/xt3vehytvn94x5y/copia%20col.xls

Saludos. DAM
Si es lo que necesitas.

He seguido todas las instrucciones y sin embargo no pegan las columnas, cuando ejecuto la macro sale que el proceso ha terminado pero no pasan los valores.
El problema que tengo es: Tengo en una carpeta varios archivos Excel con diferente nombre, cada archivo tiene una hoja que se llama datos, yo necesito extraer la
columna k de todos estos archivos y ubicarlas en uno nuevo, de verdad agradezco
mucho en lo que me puedan colaborar, porque tengo que hacer este ejercicio para más de 800 archivos diferentes.


Gracias

Realiza lo siguiente en un libro nuevo

Sigue las Instrucciones para ejecutar la macro
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Para ejecutarla presiona F5

Sub copia_columna()
'Por.DAM
hoja = "datos"
col = "K"
Application.ScreenUpdating = False
mi = ThisWorkbook.Name
Set h1 = ThisWorkbook.Sheets("Hoja1")
archi = Dir("liba*.xls*")
j = 1
'On Error Resume Next
Do While archi <> ""
    If archi <> mi Then
        Workbooks.Open archi
        'If Err.Number = 0 Then
            Sheets(hoja).Select
            Columns(col).Copy _
            h1.Cells(1, j)
            j = j + 1
        'Else
        '    Err.Number = 0
        'End If
        Application.DisplayAlerts = False
        Workbooks(archi).Close
        Application.DisplayAlerts = True
    End If
    archi = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Proceso de copiar una columna, Terminado", vbInformation, "Por.DAM.COPIA COLUMNA"
End Sub

Saludos.DAM
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas