Mover archivos de carpeta filtrando en excel

[Cristo A.Rodriguez]

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
 

[Haplox]

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

[Cristo A.Rodriguez]

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

[Haplox]

@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