Répéter la même macro en modifiant le fichier à utiliser

timon

XLDnaute Nouveau
Bonjour,
mon but pour moi est de copier des donnés de plusieurs fichier vers un seul fichier mais dans plusieurs onglets. Voici une parti de la copie :

Windows("IRL.xls").Activate
Sheets("Jan").Select
Range("P10:R17").Select
Selection.Copy
Windows("VENTES LOCALES.xlsm").Activate
Sheets("IRL").Select
Range("K61").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

J'aimerais ensuite sans avoir a tout réécrire qu'excel effectue la meme copie mais depuis un fichier différent vers un onglet différent. Pour que ce soit plus clair, il faudrait que mon code devienne :

Windows("ARM.xls").Activate
Sheets("Jan").Select
Range("P10:R17").Select
Selection.Copy
Windows("VENTES LOCALES.xlsm").Activate
Sheets("ARM").Select
Range("K61").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

J'avais tout codé à la suite mais excel me dit que c'est trop long.
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Répéter la même macro en modifiant le fichier à utiliser

Bonjour Timon, bonjour le forum,

Si les deux classeurs sont ouverts, essaie comme ça :
Code:
Sub Macro1()
Dim PL As Range 'déclare la variable PL (PLage)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)

Set PL = Workbooks("IRL.xls").Sheets("Jan").Range("P10:R17") 'définit la plage PL
Set CD = Workbooks("VENTES LOCALES.xlsm") 'définit la classeur destination CD
Set OD = CD.Sheets("IRL") 'définit l'onglet destination OD
PL.Copy 'copie la plage PL
'collage spécial dans la cellule K61 de l'onget OD
OD.Range("K61").Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False
Set OD = CD.Sheets("ARM") 'redéfinit l'onglet OD
PL.Copy 'colle la plage
'collage spécial dans la cellule K61 de l'onget OD
OD.Range("K61").Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False
End Sub
 

timon

XLDnaute Nouveau
Re : Répéter la même macro en modifiant le fichier à utiliser

Merci cela fonctionne, je vais maintenant coder pour les 66 fichiers...

Dans mon code je dois avoir tous les fichier ouvert mais est-il possible d'integrer l'ouverture puis la femeture du fichier voulu dans la macro?
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Répéter la même macro en modifiant le fichier à utiliser

Bonjour Timon, bonjour le forum,

Oui c'est possible et l'idéal dans ce genre de procédure, c'est d'avoir tous les fichiers SOURCE dans le même dossier que le fichier DESTINATION. Si ce dossier ne contient qu'eux et seulement eux (67 fichiers donc pour ton exemple) on peut facilement coder en bouclant.
La macro se trouve dans le fichier DESTINATION, elle ouvre les fichiers SOURCE les uns après les autres et récupère les données puis referme le fichier. Le problème et l'onglet de collage qui change...
Mais pour pouvoir te fournir un code il nous faut : chemin d'accès du dossier, liste des fichiers et des onglets concernés avec au moins trois fichiers exemple pour pouvoir tester...
 

timon

XLDnaute Nouveau
Re : Répéter la même macro en modifiant le fichier à utiliser

Voici trois exemples :

Tous les fichiers ce trouvent dans T:\Documents\analyse\donnés

Le fichier destination : "VENTES LOCALES.xlsm"

Les fichiers sources : "ARM.xls" "IRL.xls" "UK.xls"

Les onglets du fichier "VENTES LOCALES.xlsm" ont les même nom que le fichier source : "ARM" "IRL" et "UK".

Merci
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Répéter la même macro en modifiant le fichier à utiliser

Bonjour Timon, bonjour le forum,

Si tes 66 fichiers ont bien un onglet Jan et que les onglets du classeur Destination (= VENTES LOCALES.xlsm) ont un nom strictement identique au nom des fichiers Source, alors le code ci-dessous devrait fontionner :
Code:
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim SF As Object 'déclare la variable SF (Système de Fichiers)
Dim D As Object 'déclare la variable D (Dossier)
Dim FS As Object 'déclare la variable FS (FichierS)
Dim F As Object 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la varialbe CS (Classeur Source)
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim PL As Range 'déclare la variable PL (PLage)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF
Set D = SF.getfolder(CD.Path) 'définit le dossier de départ D
Set FS = D.Files 'définit les fichiers FS du dossier D
For Each F In FS 'boucle sur tous les fichier du dossier D
    Debug.Print F.Name
    If Not F.Name Like "*VENTES LOCALES.xlsm" Then 'condition 1 : si le nom du fichier ne contient pas "VENTES LOCALES.xlsm"
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        Set CS = Workbooks(F) 'définit le classeur Source CS (génère une erreur si le classeur n'est pas ouvert)
        If Err <> 0 Then 'condition 2 : si une erreur a été générée
            Err.Clear 'efface l'erreur
            Workbooks.Open (F) 'ouvre le classeur
            Set CS = ActiveWorkbook 'définit le classeur source CS
        End If 'fin de la condition 2
        On Error GoTo 0 'supprime la gestion des erreurs
        Debug.Print CS.Name
        Set OS = CS.Sheets("Jan") 'définit l'onglet source OS
        Set PL = OS.Range("P10:R17") 'définit la plage PL
        Set OD = CD.Sheets(Split(CS.Name, ".")(0)) 'définit l'onglet destination OD (par rapport au nom du classeur source CS)
        PL.Copy 'copie la plage PL
        'collage spécial dans la cellule K61 de l'onget OD
        OD.Range("K61").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False
        CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition 1
Next F 'prochain fichier de la boucle
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 926
Membres
101 841
dernier inscrit
ferid87