Buenos dias a todos:

Espero que me puedan ayudar, no se mucho de macros pero viendo tutoriales he podido listar los archivos de una carpeta a través de listado de nombres de una ruta y posteriormente tengo una macro que mueve los archivos de la carpeta "A" a  la carpeta "B", pero los mueve todos, a mi me gustaría que solo moviera los que filtro.

Sub MoverArchivos_Trabajo_en_curso_a_Compartido()

Dim MiArchivo As String

MiArchivo = Dir("D:\Users\carodrigueza\OneDrive - FCC\Prueba planos vigentes\01 Trabajo en curso\*")

If MiArchivo = "" Then
    MsgBox "No hay archivos a mover.", vbExclamation, "torpe"
Else

Do Until MiArchivo = ""

    Name "D:\Users\carodrigueza\OneDrive - FCC\Prueba planos vigentes\01 Trabajo en curso\" & MiArchivo As "D:\Users\carodrigueza\OneDrive - FCC\Prueba planos vigentes\02 Compartido\" & MiArchivo
    MiArchivo = Dir

Loop
End If
 

En 9/8/2022 at 10:42 , Cristo A.Rodriguez dijo:

pero los mueve todos, a mi me gustaría que solo moviera los que filtro.

Dónde están esos archivos filtrados ¿En la hoja, según alguna condición, etc? Si no especificas más es imposible ayudarte

disculpa no me di cuenta.  los archivos se filtran en la hoja. y dada esa selección mover o copiar  solo esos archivos a la otra carpeta. n oexiste ninguna condición solo datos filtrados.  yo he conseguido moverlos porque no detecta el filtro por lo que mueve toda la carpeta.

gracias por tu ayuda

@Cristo A.Rodriguez, sin tu archivo es difícil adivinar cuál es su estructura, pero teniendo en cuenta QUE TU SABES que los ficheros existen en ese directorio, puedes evitarte el Dir y el Loop. Creo que con el siguiente código debería funcionarte. Ten en cuenta que yo he supuesto que los nombres están en la columna "A"
 

Sub mover_fich()
Dim uF&
Dim nombres As Range

uF = Range("A" & Rows.Count).End(xlUp).Row

For Each nombres In Range("A2:A" & uF).SpecialCells(xlCellTypeVisible, 2)
    Name "D:\Users\carodrigueza\OneDrive - FCC\Prueba planos vigentes\01 Trabajo en curso\" & nombres As "D:\Users\carodrigueza\OneDrive - FCC\Prueba planos vigentes\02 Compartido\" & nombres
Next nombres

End Sub

 

Editado el el 14 de agosto3 años por Haplox