executer les memes operations sur plusieurs fichiers excel

M

Malkav

XLDnaute Nouveau
Bonjour à tous,

Je me nomme malkav et je suis nouveau dans le monde de VBA.

J'ai realisé une petite macro qui fonctionne pas mal, mais je me rends compte en lisant vos posts qu'elle pourrait etre optimisée.

Son but est, depuis un fichier "maitre" contenant la macro, de recuperer des infos sur 4 feuilles de plusieurs fichiers excel et de les coller sur 4 feuilles de mon fichier maitre.

Mon code est plus que perfectible, mais auriez-vous une idée pour l'optimiser.

Merci par avance. :)

Code: 
Sub test()

' defini le repertoire comme maitre

    ChDir ActiveWorkbook.Path

' arreter le rafraichissement de l'ecran

    Application.ScreenUpdating = False

' fichier 1
    
    Workbooks.Open Filename:="enregistrement1 (1).xls"
    Windows("enregistrement1 (1).xls").Activate
    Sheets("1").Select
    Cells.Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("1").Select
    Range("A1").Select
    ActiveSheet.Paste

    Windows("enregistrement1 (1).xls").Activate
    Sheets("Harmoniques %").Select
    Cells.Select
   
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques %").Select
    ActiveSheet.Paste

    Windows("enregistrement1 (1).xls").Activate
    Sheets("Harmoniques RMS").Select
    Cells.Select

    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques RMS").Select
    Range("A1").Select
    ActiveSheet.Paste

    Windows("enregistrement1 (1).xls").Activate
    Sheets("Harmoniques % 2").Select
    Cells.Select
    
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques % 2").Select
    Range("A1").Select
    ActiveSheet.Paste

    Windows("enregistrement1 (1).xls").Activate
    Sheets("Harmoniques RMS 2").Select
    Cells.Select
    
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques RMS 2").Select
    Range("A1").Select
    ActiveSheet.Paste

    Application.CutCopyMode = False
    Workbooks("enregistrement1 (1).xls").Close False
    
' fichier 2
    
    Workbooks.Open Filename:="enregistrement1 (2).xls"
    Windows("enregistrement1 (2).xls").Activate
    Sheets("1").Select
    Range("A9").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("1").Select
    Range("A10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    
    Windows("enregistrement1 (2).xls").Activate
    Sheets("Harmoniques %").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques %").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    
    Windows("enregistrement1 (2).xls").Activate
    Sheets("Harmoniques RMS").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques RMS").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    
    Windows("enregistrement1 (2).xls").Activate
    Sheets("Harmoniques % 2").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques % 2").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    
    Windows("enregistrement1 (2).xls").Activate
    Sheets("Harmoniques RMS 2").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques RMS 2").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    
    Application.CutCopyMode = False
    Workbooks("enregistrement1 (2).xls").Close False
    
    
' fichier 3
    
    Workbooks.Open Filename:="enregistrement1 (3).xls"
    Windows("enregistrement1 (3).xls").Activate
    Sheets("1").Select
    Range("A9").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("1").Select
    Range("A10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    Windows("enregistrement1 (3).xls").Activate
    Sheets("Harmoniques %").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques %").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    Windows("enregistrement1 (3).xls").Activate
    Sheets("Harmoniques RMS").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques RMS").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    Windows("enregistrement1 (3).xls").Activate
    Sheets("Harmoniques % 2").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques % 2").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    Windows("enregistrement1 (3).xls").Activate
    Sheets("Harmoniques RMS 2").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques RMS 2").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    Application.CutCopyMode = False
    Workbooks("enregistrement1 (3).xls").Close False
    
    ' fichier 4
    
    Workbooks.Open Filename:="enregistrement1 (4).xls"
    Windows("enregistrement1 (4).xls").Activate
    Sheets("1").Select
    Range("A9").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("1").Select
    Range("A10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    Windows("enregistrement1 (4).xls").Activate
    Sheets("Harmoniques %").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques %").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    Windows("enregistrement1 (4).xls").Activate
    Sheets("Harmoniques RMS").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques RMS").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    Windows("enregistrement1 (4).xls").Activate
    Sheets("Harmoniques % 2").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques % 2").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    
    Windows("enregistrement1 (4).xls").Activate
    Sheets("Harmoniques RMS 2").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Sheets("Harmoniques RMS 2").Select
    Range("A3").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Workbooks("enregistrement1 (4).xls").Close False
    
    ' activer le rafraichissement de l'ecran

Application.ScreenUpdating = True
    End Sub
 
Dernière édition:
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : executer les memes operations sur plusieurs fichiers excel

Bonjour Malkav et bienvenu, bonjour le forum,

Peut-être comme ça :
Code: 
Sub test()
Dim I As Byte 'déclare la variable I (Incrément)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim O As Object 'déclare la variable o (Onglet)
Dim Dest As Range 'déclare la variable Dest (cellule de Destination)

Set CD = ThisWorkbook 'définit la classeur destination CD
ChDir CD.Path 'defini le repertoire comme maitre
Application.ScreenUpdating = False 'arreter le rafraichissement de l'ecran
For I = 1 To 4 'boucle 1 sur les 4 fichiers
    Workbooks.Open Filename:="enregistrement1 (" & I & ").xls" 'ouvre le fichier
    Set CS = ActiveWorkbook 'définit le classeur source CS
    For Each O In CS.Sheets 'boucle 2 sur tous les onglet du classeur source CS
        'définit la cellule de destination (A1 si A1 est vide, sinon la première cellule vide de la colonne A)
        Set Dest = IIf(CD.Sheets(O.Name).Range("A1") = "", CD.Sheets(O.Name).Range("A1"), CD.Sheets(O.Name).Cells(applicatin.Rows.Count, 1).End(xlUp).Offset(1, 0))
        O.Cells.Copy Dest 'copie les cellules de O et les colle dans dest
    Next O 'prochain onglet de la boucle 2
Next I 'prochain fichier de la boucle 1
Application.ScreenUpdating = True 'activer le rafraichissement de l'ecran
End Sub
 
Vote positif 0 Vote négatif
M

Malkav

XLDnaute Nouveau
Re : executer les memes operations sur plusieurs fichiers excel

J'ai essayé et j'ai une erreur qui remonte.

Le soucis c'est que dans le fichier 1 "enregistrement1 (1)" je recupere les entêtes des tableaux.

ensuite avec les fichiers "enregistrement1 (X)" je ne recupere que les valeurs (pour cela je selectionne une cellule bien precise pour commencer les copier/coller).

je ne connais pas les commande pour dire à ma macro : " tu as des fichiers qui s'appelle "enregistement1 (n)" et je veux que tu repete une plusieurs commande similaire sur "n" fichiers. pour l'incorporer à mon fichier maitre.

j'utilise "Selection.End(xlDown).Select" et "ActiveCell.Offset(1, 0).Select" pour bien me placer à la suite des premieres colonnes.

j'ai 61 fichiers, et j'avoue que VBA me dit vite que ma macro est trop longue...
 
Vote positif 0 Vote négatif
M

Malkav

XLDnaute Nouveau
Re : executer les memes operations sur plusieurs fichiers excel

Salut,

en me servant de ton code Robert, j'ai reussi à faire ce que je voulais (je t'avouerai que c'est bien moins jolie que ton code original, mais ca fonctionne).

Par contre je me demande comment inserer la valeurs d'une cellule dans mon code.

je peux avoir de 2 à 70 fichier excel

For I = 1 To 4 'boucle 1 sur les 4 fichiers
Cliquez pour agrandir...

cette ligne me permet de dire combien j'aurai de loop, par contre comment faire si je veux remplacer le "4" par une valeur disponible dans une feuille de mon fichier maitre?

j'ai fait plusieurs essai du genre

For I = 1 To sheets("commande").range(K5).value
Cliquez pour agrandir...

Mais ca ne fonctionnne pas, ca doit etre un peu plus "touchy", mais je ne trouve pas la bonne methode... je continue de tester, mais si vous avez des idées... ben je suis preneur :p
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : executer les memes operations sur plusieurs fichiers excel

Bonjour le fil, bonjour le forum,

Essaie comme ça :
Code: 
For I = 1 To CInt(Sheets("commande").Range(K5).Value)
Ça devrait fonctionner à condition que tu aies bien un onglet commande et une valeur numérique dans la cellule K5 de cet onglet...

[Édition]
Tu peux aussi passer par une boîte d'entrée (InputBox) en rajoutant ce module en début de code puis en utilisant la variable NB :
Code: 
Dim BE As String 'déclare la variable BE (Boîte d'Entrée)
Dim NB As Integer 'déclare la variable NB (NomBre)

debut: 'étiquette
BE = InputBox("Indiquez le nombre de fichiers de la boucle !", "NOMBRE") 'définit la boîte d'entrée BE
If BE = "" Then 'condition 1 : si bouton "Annuler" ou BE non renseignée
    Exit Sub 'sort de la procédure
Else 'sinon (condition 1)
    On Error Resume Next 'gestion des erreurs (en cas d'érreur pase à la ligne suivante)
    NB = CInt(BE) 'définit le nombre NB (génère une erreur si valeur non numérique)
    If Err <> 0 Then 'condition 2 : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        MsgBox "Nombre non valide" 'message
        GoTo debut 'retourne à la boîte d'entrée vie l'étiquette "debut"
    End If 'fin de la condition 2
End If 'fin de la condition 1
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

G
  • Résolu(e)
Copie de données d'une feuille à une autre
Réponses
2
Affichages
279
gui22
G
R
  • Question
XL 2010 Effacement de données dans plusieurs feuilles de calcul dans un même classeur
Réponses
3
Affichages
359
robbynasch
R
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
320
robpellan52
R
Z
  • Question
Microsoft 365 Ajouter une étiquette de confidentialité via macro
Réponses
4
Affichages
1 K
onobyone
O
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
591
mouchtre
mouchtre
T
  • Question
Microsoft 365 Code VBA
Réponses
2
Affichages
351
thierry33670
T
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
628
Kevin38
K
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
C
  • Question
XL 2019 1004 sur un ActiveSheet.Paste
Réponses
5
Affichages
359
Cheyenne_2021
C
Usine à gaz
  • Résolu(e)
XL 2021 Affecter la valeur "ok" en colonne "F" uniquement sur les lignes visibles
Réponses
6
Affichages
390
Usine à gaz
Usine à gaz

Membres actuellement en ligne

3 membres et 46 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 611
Messages
2 090 221
Membres
104 452
dernier inscrit
hamzamounir