Aplicar macro a varios archivos de una carpeta

Navegando por internet encontré una macro muy útil que permite aplicar una misma macro a todos los libros que estén en una misma carpeta:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Mi pregunta es cómo debería modificar este código para coger directamente la ruta de una celda en mi fichero, en lugar de abrir un cuadro de diálogo en el que indicar la carpeta.

He probado varias cosas pero no me funciona ninguna (mis conocimientos de VBA son bastante justitos)... Por ejemplo:

Sub LoopThroughFiles()
    Dim xFd As Path 
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = ActiveWorkbook.Sheets("EXPORTACIÓN").Range("K4").Value 
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
            'your code here

La ruta se indicaría en la celda K4 de la hoja "EXPORTACIÓN" del libro donde está la macro, el libro activo.

1 respuesta

Respuesta
1

Quedaría así:

Sub LoopThroughFiles()
    ruta = Sheets("EXPORTACIÓN").Range("K4").Value
    If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
    xFileName = Dir(ruta & "*.xls*")
    Do While xFileName <> ""
        With Workbooks.Open(ruta & xFileName)
            'your code here
        End With
        xFileName = Dir
    Loop
End Sub

'.[Sal u dos.  No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas