sangarmatha
XLDnaute Junior
Bonjour,
J'ai adapté les macros ci-dessous a mon besoin: Création d'un répertoire suivant le contenu D3 (C:\TTT\), puis copie de fichiers dans celui ci mais je cale sur 2 points
Dans sub test, DéplacerFichiers, je voudrai utiliser le contenu des cellule B3 et D3 (chemin dossiers sur disque) qui peuvent varier au lieu d'une syntaxe figée (copie de fichier selon chemin en B3 vers chemin D3)
Je voudrai que les macros n'en fassent qu'une, mais quand je retire "sub et end sub" ça ne fonctionne pas....
Merci de votre aide
Sub Création_Rep()
Range("D3").Select
Dim Nom As String
Nom = ActiveCell.Value
MkDir Nom
End Sub
Sub copie()
'DéplacerFichiers "C:\CACO\", "C:\CACO\OS\"
DéplacerFichiers Range("B3").Select, Range("D3").Select
End Sub
Sub DéplacerFichiers(Dequel_dossier$, A_queldossier$)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For i = 8 To Sheets(1).Range("a65536").End(xlUp).Row
fso.CopyFile Dequel_dossier & "\" & Cells(i, 1) & ".txt", A_queldossier & "\"
Next
On Error GoTo 0
End Sub
J'ai adapté les macros ci-dessous a mon besoin: Création d'un répertoire suivant le contenu D3 (C:\TTT\), puis copie de fichiers dans celui ci mais je cale sur 2 points
Dans sub test, DéplacerFichiers, je voudrai utiliser le contenu des cellule B3 et D3 (chemin dossiers sur disque) qui peuvent varier au lieu d'une syntaxe figée (copie de fichier selon chemin en B3 vers chemin D3)
Je voudrai que les macros n'en fassent qu'une, mais quand je retire "sub et end sub" ça ne fonctionne pas....
Merci de votre aide
Sub Création_Rep()
Range("D3").Select
Dim Nom As String
Nom = ActiveCell.Value
MkDir Nom
End Sub
Sub copie()
'DéplacerFichiers "C:\CACO\", "C:\CACO\OS\"
DéplacerFichiers Range("B3").Select, Range("D3").Select
End Sub
Sub DéplacerFichiers(Dequel_dossier$, A_queldossier$)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For i = 8 To Sheets(1).Range("a65536").End(xlUp).Row
fso.CopyFile Dequel_dossier & "\" & Cells(i, 1) & ".txt", A_queldossier & "\"
Next
On Error GoTo 0
End Sub