Regrouper plusieurs macros (6 modules) en une seule macro

Bonjour Team,

J'ai besoin de votre aide s'il vous plait.

J'ai plusieurs macros que j'exécute une après l'autre (6 modules) au total.

Pouvez-vous m'aider à les regrouper en une seule étape avec un seul ou deux boutons please.

J'ai joins un fichier avec les macros et chaque bouton décrit une étape.

Je reste à votre disposition si besoin.

Bonjour,

Il suffit d'appeler les 6 macros à tour de rôle dans une seule et même macro et affecter cette macro à 1 seul bouton.

Dans votre cas (j"ai laissé volontairement le nom des feuilles, mais il ne sont peut-être pas nécessaires)

Sub Execution_Globale()
    Application.ScreenUpdating = False

    'Etape 1
    Sheets("Feuil1").Select
    reconstitution_vers

    'Etape 2
    Sheets("Feuil1_bis").Select
    CombineRows

    'Etape 3
    Sheets("Feuil1_bis").Select
    decomposer_versement

    'Etape 4
    Sheets("Feuil2").Select
    reconstitution_engagement

    'Etape 5
    Sheets("Feuil2_bis").Select
    CombineRows

    'Etape 6
    Sheets("Feuil2_bis").Select
    decomposition_engagement

    'Etape 7
    Sheets("Feuil2").Select
    Copie
End Sub

Cdlt

Bonjour Arthuro83;

Je vous remercie pour votre retour. Le programme fonctionne super bien!

Par contre je suis confronté à un petit problème sur le module2.

Je suis obligé de sélectionner manuellement la plage A:B des feuils "Feuil1_bis" et "feuil2_bis".

Serait-il possible de me fixer les deux colonnes à l'exécution du module2 s'il vous plait.

Je vous remercie !

Bonjour,

La macro du module 2 modifiée (pas testée)

Sub CombineRows()
    'Updateby Extendoffice
    Dim WorkRng As Range
    Dim Dic As Variant
    Dim arr As Variant

    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    Set WorkRng = Application.Range("A2;B" & DerLig)
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Set Dic = CreateObject("Scripting.Dictionary")
    arr = WorkRng.Value
    For i = 1 To UBound(arr, 1)
        Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
    Next
    Application.ScreenUpdating = False
    WorkRng.ClearContents
    WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
    WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
End Sub

Cdlt

Bonjour Arthuro83,

Je vous remercie pour votre retour.

J'ai essayé d'adapter le code à mon fichier mais rien ne se passe.

Je précise que mon souhait est d'appliquer ce code aux deux feuilles "Feuil1_bis" et "Feuil2_bis" et aux deux colonnes "A" et "B".

Je vous remercie !

Bonjour,

Dans la ligne suivante:

Set WorkRng = Application.Range("A2;B" & DerLig)

J'ai fait une erreur de frappe, remplacez le point virgule ; par deux points :

Cdlt

Bonjour Arturo83,

Super ça fonctionne parfaitement bien.

C'est vraiment sympa de votre part !

Une excellente journée !

Bonsoir Arturo83,

J'espère que vous allez bien.

J'ai besoin de votre aide pour finaliser mon besoin.

Je voudrai pouvoir choisir mon fichier source dans un répertoire où il est déposé chaque mois.

En effet, c'est la MOA qui l'extrait chaque mois puis me le dépose dans un répertoire.

Comme il change chaque mois, mes macros ne peuvent pas être dans ce fichier.

Le fichier source contient plusieurs onglets. Pour l'instant j'ai besoin uniquement les deux onglets "source_engagement" et "source_versement" et donc je voudrai sélectionner ces onglets quand j'aurai chargé le fichier source.

Je joins les deux fichiers "source" et le fichier contentant mes macros.

Je vous remercie vraiment !!!!!

Bonjour,

Copiez ceci dans un des modules du classeur contenant les macros.

Sub Selection_Fichier()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False 'ne pas avoir de messages d'alertes
    Classeur_Macro = ThisWorkbook.Name 'on affecte la variable "Classeur_Macro"  au classeur contenant les macros
    Fich_ouvrir = Application.GetOpenFilename(filefilter:="tout,*.*", Title:="Sélection") 'on sélectionne le fichier source
    Workbooks.Open Filename:=Fich_ouvrir 'on ouvre le fichier source sélectionné
    Classeur_Source = ActiveWorkbook.Name 'on affecte la variable "Classeur_Source"  au classeur contenant les données sources
    Sheets("SOURCE_VERSEMENT").Select 'on va sur la feuille "SOURCE_VERSEMENT"
    Range("A1").CurrentRegion.Copy ' on copie  les données
    Windows(Classeur_Macro).Activate ' on revient sur le classeur des macros
    Sheets("VERSEMENT").Select 'on va sur la feuille "VERSEMENT"
    Range("A1").Select 'on se positionne sur la cellule A1
    ActiveSheet.Paste 'on colle tout

    Windows(Classeur_Source).Activate
    Sheets("SOURCE_ENGAGEMENT").Select 'on va sur la feuille "SOURCE_ENGAGEMENT"
    Range("A1").CurrentRegion.Copy ' on copie  les données
    Windows(Classeur_Macro).Activate ' on revient sur le classeur des macros
    Sheets("ENGAGEMENT").Select 'on va sur la feuille "ENGAGEMENT"
    Range("A1").Select 'on se positionne sur la cellule A1
    ActiveSheet.Paste 'on colle tout

    Windows(Classeur_Source).Activate 'on retourne sur le classeur source
    ActiveWorkbook.Close 'on le ferme
End Sub

Au lancement de la macro, vous sélectionnerez le fichier source, et les données seront recopiées dans les feuilles de destinations.

Cdlt

Bonjour Arturo83,

Je vous remercie infiniment pour votre programme.

Il fonctionne parfaitement.

D'ailleurs je m'en inspire pour améliorer d'autres macros que j'utilisais.

C'est vraiment très sympa de votre part !

Excellent week-end à vous !

Bonjour à tous,

Pas trop fan de UsedRange, voici un petit exemple qui tire profits des liaisons de classeurs.

On pourrait y rajouter une gestion d'erreurs

Sub DatasImport(FullPathName As String, Datas)
Dim sh As String, sql As String, c

    With Workbooks(ThisWorkbook.Name)
        For Each sh In VBA.Array("Verssement", "Engagements")
            For Each c In Datas
                sql = "='" & Left(FullPathName, InStrRev(FullPathName, "\", , vbTextCompare)) & _
                      "[" & Mid(FullPathName, InStrRev(FullPathName, "\", , vbTextCompare) + 1) & "]" & Replace(c, "!", "'!")

                Worksheets(sh.Name).Range("A1").FormulaR1C1 = sql
                ActiveWorkbook.BreakLink Name:= _
                                         sql, Type:=xlExcelLinks
            Next c
        Next sh

    End With
End Sub

Et pour l'appel cela donne:

DatasImport "C:\Répertoire\Source-Business-object.xlsx", vba.array("Feuil1!Tableau1","Feuil2!Tableau2")

nb Les feuilles sont appelées par leur codeName

On pourrait aussi faire:

DatasImport Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xls*), *.xls*", Title:="Sélectionnez un fichier"), _
                VBA.Array("Feuil1!Tableau1", "Feuil2!Tableau2")

Bonjour Arturo83,

C’est dans ce titre qu’on retrouve votre programme.

« Regrouper plusieurs macros (6 modules) en une seule macro ».

Bonne soirée