Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro pour MAJ données via un second fichier Excel

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Pierre_C
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
P

Pierre_C

XLDnaute Nouveau
Bonjour,
Je débute en macros et je dois en réaliser une permettant ceci:
- activée depuis le fichier Excel 1, elle doit permettre l'ouverture d'un fichier Excel 2 que l'utilisateur doit pouvoir choisir sur son disque dur
- elle doit permettre la récupération de données sur le fichier 2, informations réparties sur 10 onglets différents, pour les insérer au fichier 1
- elle doit fermer le fichier 2 une fois finie l'extraction

En farfouillant sur le forum j'ai réussi à trouver la solution pour proposer à l'utilisateur d'ouvrir un fichier Excel de son choix.
Cependant, je bloque dans la mesure où je ne sais pas comment modifier le code pour que dans la suite du code la référence au fichier 2 se fasse en fonction du fichier ouvert (quel qu'il soit).
Je ne sais également pas comment faire fermer le fichier 2 par la macro.

Je vous colle ci-dessous où j'en suis arrivé, c'est sommaire mais c'est un début:
En rouge, l'endroit où ça bloque pour le nom du fichier

Merci d'avance de votre aide!

Pierre

Code: 
Sub CalculETPs()
'
' CalculETPs Macro
'

'
'ouverture du fichier source (dernière version de la fiche programme)
    Dim Fichier, NomFichier$
Fichier = Application.GetOpenFilename("Fichiers Microsoft Office Excel, *.xlsx")
If Fichier = False Then Exit Sub
If Fichier Like "*\" & ThisWorkbook.Name Then MsgBox "Ouverture non autorisée.": Exit Sub
On Error Resume Next
Workbooks.Open Fichier
On Error GoTo 0
NomFichier = Dir(Fichier)
Workbooks(NomFichier).Activate
'récupération des données une par une par copier coller
    Windows( _
 [COLOR="#FF0000"]       "NomFichier" _[/COLOR]
        ).Activate
    Sheets("CA01 Ecarts Techniques").Select
    Range("H14:AK16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Workbooks(NomFichier).Activate
    Range("H28:AK30").Select
    Range("AK28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "Dir(Fichier)" _
        ).Activate
    Sheets("CA02 Modèle Technique").Select
    ActiveWindow.SmallScroll Down:=-6
    Range("H14:AN16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AN30").Select
    Range("AN28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Sheets("CA03 Infrastructure").Select
    Range("H14:AT16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AT30").Select
    Range("AT28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Sheets("CA05 Sécurité").Select
    Range("H14:AT16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AT30").Select
    Range("AT28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Sheets("CA06 System Management").Select
    Range("H14:AK16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AK30").Select
    Range("AK28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Sheets("CA07 Service Management").Select
    Range("H14:AK16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=12
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AK30").Select
    Range("AK28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F39").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Sheets("CA08 Intégration").Select
    Range("H14:AH16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F42").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AH30").Select
    Range("AH28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F45").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Sheets("CA09 Env. de Migration").Select
    Range("H14:AT16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX1 - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=15
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AT30").Select
    Range("AT28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F51").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    ActiveWindow.SmallScroll Down:=6
    Sheets("CA10 Pilotage Projet Prod.").Select
    Range("H14:AT16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F54").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AT30").Select
    Range("AT28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F57").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows( _
        "NomFichier" _
        ).Activate
    Sheets("CA11Org. Build Prod.Run").Select
    Range("H14:AK16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F60").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=6
    Windows( _
        "NomFichier" _
        ).Activate
    Range("H28:AK30").Select
    Range("AK28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows( _
        "XXX - Calcul des ETP CC du 20 Juin à fin Avril avec Avenant (Vue par CA) 20120613 V0.o.xls" _
        ).Activate
    Range("F63").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-39
    Range("F6").Select
    Application.CutCopyMode = False
    Calculate
    Sheets("XXX").Select
'ici, manque un code pour faire fermer le fichier 2 par la macro
End Sub
 
Trier par date Trier par votes
Re : Macro pour MAJ données via un second fichier Excel

Bonjour.
Ne réactivez pas le classeur destinataire qui est celui qui contient la macro si j'ai bien compris.
Comme ça ce sera toujours ActiveWorkbook.
N'utilisez aucun Activate ni Select jamais nulle part.
La feuille destinatrice dans ThisWorkbook est toujours connue sous son CodeName.
À +
 
Vote positif 0 Vote négatif
Re : Macro pour MAJ données via un second fichier Excel

La macro n'a pas apprécié la suppression de tous les .Activate et les .Select
Elle bloque toujours sur des liaisons sur le fichier 2 qui l'empêchent de tourner, je n'arrive pas à supprimer ces liaisons.

Edition: avec un peu de persévérance, ça marche finalement! Merci!
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

N
  • Résolu(e)
Microsoft 365 Macro entre 2 classeurs
2
Réponses
19
Affichages
508
Nounours4173
N
C
  • Question Question
Microsoft 365 Enregistrer via VBA sans ouvrir fichier
Réponses
9
Affichages
423
cdric78
C
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
426
AtTheOne
  • Résolu(e)
XL 2019 Renvoyé à la ligne suivante si la ligne demandé n'est pas libre
Réponses
9
Affichages
198
Phil69970
  • Résolu(e)
XL 2016 macro fichier fermé
Réponses
1
Affichages
136
eastwick
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
653
ph.vanne
  • Question Question
XL 2016 copier valeur actuel
2
Réponses
18
Affichages
422
sylvanu
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
340
sylvanu
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
547
micie1509
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
780
Phil69970
M
  • Question Question
XL 2021 VBA Excel Erreur 2023
Réponses
2
Affichages
345
MICHIS
M
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
1 K
MICHAEL
M
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
2 K
job75
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
719
robpellan52
R
Z
  • Question Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
471
zendb
Z
F
  • Résolu(e)
Microsoft 365 Message Box oui/non
Réponses
2
Affichages
432
Francky79
F
V
  • Question Question
XL pour MAC outil coller le contenu du presse papier
Réponses
2
Affichages
696
Valter
V
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
805
gwenn49
G
O
  • Question Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
844
olivier388
O
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
3 K
AtTheOne
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…