Microsoft 365 Réduire la taille de la macro ?

guiyom

XLDnaute Junior
Bonjour,

Je viens de réaliser une macro VBA très répétitive et plutôt longue. Elle est tellement longue qu'Excel refuse de l'exécuter, indiquant que la procédure est trop grande.

Une fois de plus, mon manque de connaissances me fait défaut. C'est pourquoi je vous sollicite afin de savoir s'il est possible de l'a réduire.

Ma macro consiste à coller des informations sur les 35 pages Excel, de "BQ1" à "BQ35", en fonction du type de fruits ("AAA", "BBB", "CCC", "DDD", "EEE").

Bien cordialement

VB:
Dim jour As String
Dim mois As String
Dim annee As String
Dim chemin As String
Dim txt_name As String
Dim pomme As String
Dim poire As String
Dim fraise As String
Dim raisin As String
Dim orange As String
Dim mandarine As String
Dim abricot As String
Dim ligne As String

jour = Format(Day(CDate(Worksheets("PDF").Range("u1"))), "00")
mois = Format(Month(CDate(Worksheets("PDF").Range("u1"))), "00")
annee = Cells(4, 21).Value


Application.ScreenUpdating = False

chemin = ActiveWorkbook.Path & "\" & "TXTs\"
   
   
If bq1.Name <> "BQ1" Then
   
    If Dir(chemin & "\" & bq1.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
   
        txt_name = bq1.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value

        ThisWorkbook.Sheets("PDF").Activate
 
        Cells(9, 8).Value = pomme
        Cells(9, 9).Value = poire
        Cells(9, 10).Value = fraise
        Cells(9, 11).Value = raisin
        Cells(9, 12).Value = orange
        Cells(9, 13).Value = mandarine
        Cells(9, 14).Value = abricot


            If Sheets("Parametrage").Range("D4").Value = "AAA" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D4").Value = "BBB" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D4").Value = "CCC" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D4").Value = "DDD" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D4").Value = "EEE" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If

        Workbooks(2).Close (False)
       
    Else
   
        MsgBox (bq1.Name & " est introuvable")
   
    End If
   
End If
   
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If bq2.Name <> "BQ2" Then
 
    If Dir(chemin & "\" & bq2.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
   
        txt_name = bq2.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value

        ThisWorkbook.Sheets("PDF").Activate
 
        Cells(10, 8).Value = pomme
        Cells(10, 9).Value = poire
        Cells(10, 10).Value = fraise
        Cells(10, 11).Value = raisin
        Cells(10, 12).Value = orange
        Cells(10, 13).Value = mandarine
        Cells(10, 14).Value = abricot

            If Sheets("Parametrage").Range("D5").Value = "AAA" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D5").Value = "BBB" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D5").Value = "CCC" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D5").Value = "DDD" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D5").Value = "EEE" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If
 
        Workbooks(2).Close (False)
   
    Else
   
        MsgBox (bq2.Name & " est introuvable")
   
    End If
           
End If
   
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If bq3.Name <> "BQ3" Then
 
    If Dir(chemin & "\" & bq3.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
 
        txt_name = bq3.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value

        ThisWorkbook.Sheets("PDF").Activate
 
        Cells(11, 8).Value = pomme
        Cells(11, 9).Value = poire
        Cells(11, 10).Value = fraise
        Cells(11, 11).Value = raisin
        Cells(11, 12).Value = orange
        Cells(11, 13).Value = mandarine
        Cells(11, 14).Value = abricot

        If Sheets("Parametrage").Range("D6").Value = "AAA" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D6").Value = "BBB" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D6").Value = "CCC" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D6").Value = "DDD" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D6").Value = "EEE" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If
 
        Workbooks(2).Close (False)
   
     Else
   
        MsgBox (bq3.Name & " est introuvable")
   
     End If
             
End If
   
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If bq4.Name <> "BQ4" Then
   
    If Dir(chemin & "\" & bq4.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
 
        txt_name = bq4.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value

        ThisWorkbook.Sheets("PDF").Activate
 
        Cells(12, 8).Value = pomme
        Cells(12, 9).Value = poire
        Cells(12, 10).Value = fraise
        Cells(12, 11).Value = raisin
        Cells(12, 12).Value = orange
        Cells(12, 13).Value = mandarine
        Cells(12, 14).Value = abricot

            If Sheets("Parametrage").Range("D7").Value = "AAA" Then

                ThisWorkbook.Sheets(bq4.Name).Activate

                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D7").Value = "BBB" Then

                ThisWorkbook.Sheets(bq4.Name).Activate

                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D7").Value = "CCC" Then

                ThisWorkbook.Sheets(bq4.Name).Activate

                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D7").Value = "DDD" Then

                ThisWorkbook.Sheets(bq4.Name).Activate

                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D7").Value = "EEE" Then
           
                ThisWorkbook.Sheets(bq4.Name).Activate
               
                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If
 
        Workbooks(2).Close (False)
       
    Else
   
        MsgBox (bq4.Name & " est introuvable")
   
    End If
           
End If
   
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If bq35.Name <> "BQ35" Then
 
    If Dir(chemin & "\" & bq35.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
 
        txt_name = bq35.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value
       
        ThisWorkbook.Sheets("PDF").Activate
       
        Cells(43, 8).Value = pomme
        Cells(43, 9).Value = poire
        Cells(43, 10).Value = fraise
        Cells(43, 11).Value = raisin
        Cells(43, 12).Value = orange
        Cells(43, 13).Value = mandarine
        Cells(43, 14).Value = abricot

            If Sheets("Parametrage").Range("D38").Value = "AAA" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If
           
            If Sheets("Parametrage").Range("D38").Value = "BBB" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If
           
            If Sheets("Parametrage").Range("D38").Value = "CCC" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If
           
            If Sheets("Parametrage").Range("D38").Value = "DDD" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If
           
            If Sheets("Parametrage").Range("D38").Value = "EEE" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If
 
        Workbooks(2).Close (False)
     
     Else
   
        MsgBox (bq35.Name & " est introuvable")
   
     End If
         
End If

Worksheets("PDF").Visible = False
 
End Sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour @guiyom , le fil


Puisque que tu disposes d'Office 366, tu pourrais utiliser PowerQuery pour "combiner" tes N fichiers *txt dans ton classeur Excel.
(Pas besoin de VBA, se manipule à la souris, et la requête créé est actualisable)

Tu peux joindre un exemple simplifié et anonymisé de ton classeur Excel et d'un fichier *.txt ?
(en les mettant tous les deux dans un fichier Zip)
 

Gégé-45550

XLDnaute Accro
Bonjour messieurs

Que celui qui n'a jamais ripper sur son clavier me lance le premier ripp

En attendant les fichiers, je retourne me fader les ailes tristes de la destinée.
(mais version studio)
No pb l'ami, on l'a tous fait ... et plus souvent qu'à notre tour, c'était juste pour sourire (il paraît qu'il faut le faire au moins une fois par jour) et ça n'avait rien de personnel, bien au contraire !
Toutes mes excuses si ce joke t'a blessé !
 

Staple1600

XLDnaute Barbatruc
Re

@Gégé-45550
Je vois que tu n'as pas cliqué sur le lien dans mon message.
Celui-ci étant censé indiquer que je suis dans le registre de l'humour ;)
D'un autre côté, si tu n'aimes pas le cuir, et les clous, tu auras épargné tes yeux ;)

NB: Observe le titre de ce qui passera entre tes oreilles quand tu cliqueras sur le lien
Et tu comprendras (j'espère le trait d'humour)

En attendant, le demandeur a du abusé de la poire, au point d'être tombé dans les pommes.
;)
 

Gégé-45550

XLDnaute Accro
Re

@Gégé-45550
Je vois que tu n'as pas cliqué sur le lien dans mon message.
Celui-ci étant censé indiquer que je suis dans le registre de l'humour ;)
D'un autre côté, si tu n'aimes pas le cuir, et les clous, tu auras épargné tes yeux ;)

NB: Observe le titre de ce qui passera entre tes oreilles quand tu cliqueras sur le lien
Et tu comprendras (j'espère le trait d'humour)

En attendant, le demandeur a du abusé de la poire, au point d'être tombé dans les pommes.
;)
Priest aurait du s'appeler Jack plutôt que Judas ! ... et, d'accord, le cuir et les clous, c'est pas trop mon truc.
Bien amicalement,
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous ;),

Encore un autre doigt fourchu de @Staple1666 😈 et on passe d'Office 366 à 666. Et là c'est une tout autre histoire car si le diable vient se mêler à Judas et au prêtre, il va falloir redouter les pire malheurs précurseurs de l’apocalypse😧.

nota : il est tout mimi le Rob Halford avec ces clous tout partout 😛.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour @mapomme

Comment passer d'un panier de fruits, au doigt malhabile à l'Antéchrist de pacotille pour finir sur ce chef d'oeuvre de 65 moins deux ?
Je me le demande encore ;)

Et si en plus on ajoute le chat flatulant dans le Range pour rester dans le theme Excel ;)
Il est plus temps que guiyom revienne avec des fichiers exemples pour qu'enfin on fasse de l'Excel (avec ou sans clous)
;)
 

Discussions similaires

Réponses
0
Affichages
223

Statistiques des forums

Discussions
313 315
Messages
2 097 055
Membres
106 822
dernier inscrit
jolost2