Discussion :

[Galdwin]

Bonjour,

Chaque mois j'ai un fichier que je reçoit.
Après modification des données je doit copier ce fichier dans environ 100 autre fichiers. Vous comprendrez que copier coller c'est lourd.

J'ai trouvé une macro comme ci-dessous, je met le chemin de mon fichier en collone B, sont nom exacte en collone C ainsi que mes chemin de destination dans la collone F.
Mais il me copie que le premier et pas les suivants.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub CopierColler()
Dim Dossier_cherché As String, Fichier_cherché As String, Dossier_récepteur As String
 
Application.ScreenUpdating = False
Dossier_récepteur = Range("F12")
Range("B12").Activate
Range("B13").Activate
Do Until ActiveCell = ""
Dossier_cherché = ActiveCell
Fichier_cherché = ActiveCell.Offset(0, 1)
 
Workbooks.Open Filename:=Dossier_cherché & "\" & Fichier_cherché
ActiveWorkbook.SaveAs Filename:=Dossier_récepteur & "\" & Fichier_cherché
ActiveWorkbook.Close
 
ActiveCell.Offset(1, 0).Activate
Loop
 
End Sub

Avez vous une solution pour qu'il me copie bien mon fichier dans plusieur repértoire différent.

Cordialement.

[verredewhisky]

Il faut faire une itération sur la cellule à sélectionner

faux :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ActiveCell.Offset(1, 0).Activate

juste :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
ActiveCell.Offset(i, 0).Activate
i = i + 1

ou bien :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub CopierColler()
Dim Dossier_cherché As String, Fichier_cherché As String, Dossier_récepteur As String
 
Application.ScreenUpdating = False
Dossier_récepteur = Range("F12").value
i = 13
Do Until Range("B" & i).Value = ""
Dossier_cherché = Range("B" & i).value
Fichier_cherché =Range("C" & i).value
 
Workbooks.Open Filename:=Dossier_cherché & "\" & Fichier_cherché
ActiveWorkbook.SaveAs Filename:=Dossier_récepteur & "\" & Fichier_cherché
ActiveWorkbook.Close
i=i+1
Loop
 
End Sub

[parmi]

Bonjour,

Il faut faire la distinction entre Copier un fichier dans 100 autres et sauvegarder un fichier sous 100 noms différents...

[Galdwin]

Merci mais ton code marche pas.

Pour vous aidez un peu plus je vais mieux détailler.

En B12=Chemin de mon fichier à copier
En C12=Nom exact du Fichier à copier

En F12=1 er chemin où coller le fichier
En F13=2 éme chemin où coller le fichier
En F14=3 éme chemin où coller le fichier
Et ainsi du suite jusque 100 environ..

Lorsque je lance ma macro sa ne copie le fichier uniquement dans le 1 er chemin où coller et stop après.

Merci d'avance

Cordialement

[parmi]

Si je comprends bien, les chemins sont en F et tu veux sauvegarder ton fichier avec le même nom dans ces répertoires... c'est ça ?

Ceci devrait faire l'affaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub CopierColler()
    Dim I As Long, nbLignes As Long
 
    nbLignes = Cells(Rows.Count, "F").End(xlUp).Row
 
    For I = 12 To nbLignes
        'Copie le fichier dans le chemin inscrit dans la colonne F
        'avec le même nom que le fichier original
        ThisWorkbook.SaveCopyAs Range("F" & I) & "\" & ThisWorkbook.Name
    Next
 
End Sub

[Galdwin]

Merci pour ta réponse, c'est presque çà ^^ en faite avec ta macro sa me copie et colle le fichier où je place la macro.
Mais le fichier que je veux copier coller n'est pas celui-ci.
C'est un autre fichier. Le lien de ce fichier ce trouve en colonne B12 et sont nom en C12. le lient de destination en colonne F fonctione bien ^^.

Pourrais tu rajouter le lien du fichier source qui se trouve toujours en B12. Ainsi que sont nom toujours en C12.
Exemple:
Lien en B12: "C:\Perso\TESTE"
Nom en C12 : "Teste.txt"

Merci d'avance

Edit:

Après plusieur modification j'arrive à çà.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub CopierColler()
    Dim I As Long, nbLignes As Long, Dossier_cherché As String, Fichier_cherché As String, Dossier_récepteur As String
 
    nbLignes = Cells(Rows.Count, "F").End(xlUp).Row
    Dossier_cherché = Range("B12")
    Fichier_cherché = Range("C12")
 
    For I = 12 To nbLignes
        'Copie le fichier dans le chemin inscrit dans la colonne F
        'avec le même nom que le fichier original
    Dossier_récepteur = Range("F" & I)
    Workbooks.Open Filename:=Dossier_cherché & "\" & Fichier_cherché
        ActiveWorkbook.SaveAs Filename:=Dossier_récepteur & "\" & Fichier_cherché
        ActiveWorkbook.Close
    Next
 
End Sub

Le code marche mais mouvre le fichier et me demande de sauvegarder les modifications alors qu'il y en a aucune. Peut ton faire le copier coller sans ouvrir le fichier pour éviter ce message.

Cordialement

[parmi]

Avec le code que tu proposes, ajoute False après ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.Close False

Il n'y aura pas de sauvegarde et donc pas de message, en principe.

Mais plutôt que de l'ouvrir et le fermer, ce qui ne sert à rien, intéresse-toi à l'instruction FileCopy

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FileCopy SourceFile, DestinationFile

N'oublie pas de mettre le nom du fichier ainsi que le chemin complet dans les 2 cas (SourceFile et DestinationFile)
SourceFile devrait être Dossier_cherché & "\" & Fichier_cherché
DestinationFile devrait être Dossier_récepteur & "\" & Fichier_cherché