Copier coller dans plusieurs fichiers

Bonjour à tous,

je fais à nouveau appel à vos connaissances.

Voilà mon problème, je souhaite copier depuis un fichier source "source_v3" les lignes de 4 à 12 dans plusieurs fichiers destinations.

Les fichiers destinations ont le même format que source à l'exception de ces lignes.

Le fichier source se trouve dans: D:\Pascal_PC\Documents\Test\Source

Les fichiers destinations se trouvent dans: D:\Pascal_PC\Documents\Test\Destination.

Je joint le fichier source et un exemple de fichier destination.

Je peux avoir jusqu'à 50 fichiers dans le répertoire "Destination"

J'espère avoir été clair

Bonjour à tous,

Peut être une piste qui pourrait m'aider à commencer...

Bien cordialement

Re,

j'ai rédigé ce debut de code pour faire un copier coller des cellules dont j'ai besoin.

Mais pour le collage, il fait référence à un fichier précis. J'aimerai que le collage se fasse sur la feuille que j'ai sélectionnée.

Je ne trouve pas la solution.

Peut être pouvez vous m'orienter?

Merci d'avance.

Sub Transf_gm()
'
' Transf_gm Macro
'
    Windows("source_v3.xls").Activate
    Rows("4:12").Select
    Selection.Copy
    Windows("AGNEAC004616T.xls").Activate
    Rows("4:4").Select
    ActiveSheet.Paste
    Selection.EntireRow.Hidden = True
    Range("A13").Select
End Sub

Bonjour

Dans un premier temps il faut lister les fichiers dans le répertoire puis tu peux exécuter ton code en listant chaque cellule.

 
    Dim Chemin As String, Fichier As String, compteur As Integer

    'Définit le répertoire contenant les fichiers
    Chemin = "D:\Pascal_PC\Documents\Test\Destination\"

    'nettoyage des précédentes listes dans une feuille Liste
    Sheets("Liste").Select
    Columns("A:A").Select
    Selection.ClearContents

    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*.*")
    compteur = 1
    Do While Len(Fichier) > 0
        Sheets("Liste").Range("A" & compteur) = Chemin & Fichier
        Fichier = Dir()
        compteur = compteur + 1
    Loop
End sub

 

Bonjour Stephdu13 et merci pour ta réponse dont je me suis inspiré pour rédiger ce code

Sub zbalay_gmaor()

Dim repertoire As String
Dim wbook As Workbook
repertoire = "D:\Pascal_PC\Documents\Test\Destination"

unFichier = Dir(repertoire & "*.xls")
While unFichier > 0
    Set wbook = Workbooks.Open(repertoire & unFichier, , True)
    'appel de la macro
    Call ZTransf_gmaor
    wbook.Close False
    unFichier = Dir
Wend
End Sub

Mais il y a une erreur sur la ligne: Set wbook qui me renvoie:

Set wbook=Nothing

Auriez vous une idée sur la cause de cette erreur?

A vous lire.

Bonjour

Il manque un "\" à la fin du chemin

repertoire = "D:\Pascal_PC\Documents\Test\Destination\"

Merci Stephdu13 pour ton aide,

tout fonctionne parfaitement après quelques ajustements

A bientôt

Je t'en prie.