Macro para incluir una subcarpeta dentro de subcarpeta
Para Dante Amor
Querido amigo funciona muy bien la macro, pero quisiera agregarle que busque en una subcarpeta más ejemplo: resumen de acciones\MDF\niko
Lo he hecho pero se ve que algo en la sintaxis no me cierra y me da error.
Respuesta de Dante Amor
3
E stimado al final de mi respuesta hay un para de botones para valorar la respuesta: "Votar" y "Excelente", si requieres más información sobre mi respuesta o mi respuesta está incompleta a lo que solicitaste, puedes solicitar más información, de lo contrario podrías cambiar la valoración.
Regresando a tu pregunta, prueba con la siguiente macro:
Public ws, iRow, mFolder, iFile
'
Sub copia_hojas()
'------------------
'by niko
'Act.Por.Dante Amor
'------------------
Dim ws As Worksheet, iFile$, iRow&, mFolder$
Set ws = ActiveSheet
ws.Range(ws.[a1], ws.[a1].SpecialCells(11)).Offset(1).Delete xlShiftUp
iRow = 2
Folders = Array(ThisWorkbook.Path & "\resumen de acciones", _
ThisWorkbook.Path & "\resumen de acciones\MDF", _
ThisWorkbook.Path & "\resumen de acciones\MDF\niko")
For i = LBound(Folders) To UBound(Folders)
mFolder = Folders(i)
iFile = Dir(mFolder & "\*.xls*")
Do Until iFile = ""
Call copiar(ws, iRow, mFolder, iFile)
iFile = Dir
Loop
Next
'
MsgBox "Fin"
End Sub
'
Sub copiar(ws, iRow, mFolder, iFile)
With ws.Cells(iRow, "a").Resize(150, 7)
.Formula = "=if('" & mFolder & "\[" & iFile & "]5porque'!g19 ="""", """" ,'" & mFolder & "\[" & iFile & "]5porque'!g19)"
.Value = .Value
End With
iRow = iRow + 150
tope = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
For f = tope To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(f)) = 0 Then Rows(f).EntireRow.Delete
Next
Columns("A:A").WrapText = True
Columns("B:B").WrapText = True
Columns("C:C").WrapText = True
Columns("D:D").WrapText = True
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
