Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Aide pour réduction de code


Sujet :

Macros et VBA Excel

  1. #1
    Futur Membre du Club
    Aide pour réduction de code
    Bonjour forum

    est ce que possible de réduire se code :
    Merci
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
     
    Private Sub CommandButton2_Click()
     Dim sh
        Application.ScreenUpdating = 0
        For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
     
            Sheets("ASSURANCE").Range("B3:C32").Copy Sheets(sh).Range("B3")
            Sheets("ASSURANCE").Range("B36:C65").Copy Sheets(sh).Range("B36")
            Sheets("ASSURANCE").Range("B69:C98").Copy Sheets(sh).Range("B69")
            Sheets("ASSURANCE").Range("B102:C131").Copy Sheets(sh).Range("B102")
            Sheets("ASSURANCE").Range("B135:C164").Copy Sheets(sh).Range("B135")
            Sheets("ASSURANCE").Range("B168:C197").Copy Sheets(sh).Range("B168")
            Sheets("ASSURANCE").Range("B201:C230").Copy Sheets(sh).Range("B201")
            Sheets("ASSURANCE").Range("B234:C263").Copy Sheets(sh).Range("B234")
            Sheets("ASSURANCE").Range("B267:C296").Copy Sheets(sh).Range("B267")
            Sheets("ASSURANCE").Range("B300:C329").Copy Sheets(sh).Range("B300")
     
            Sheets("ASSURANCE").Range("B333:C362").Copy Sheets(sh).Range("B333")
            Sheets("ASSURANCE").Range("B366:C395").Copy Sheets(sh).Range("B366")
            Sheets("ASSURANCE").Range("B399:C428").Copy Sheets(sh).Range("B399")
            Sheets("ASSURANCE").Range("B432:C461").Copy Sheets(sh).Range("B432")
            Sheets("ASSURANCE").Range("B465:C494").Copy Sheets(sh).Range("B465")
            Sheets("ASSURANCE").Range("B498:C527").Copy Sheets(sh).Range("B498")
            Sheets("ASSURANCE").Range("B531:C560").Copy Sheets(sh).Range("B531")
            Sheets("ASSURANCE").Range("B564:C593").Copy Sheets(sh).Range("B564")
            Sheets("ASSURANCE").Range("B597:C626").Copy Sheets(sh).Range("B597")
            Sheets("ASSURANCE").Range("B630:C659").Copy Sheets(sh).Range("B630")
     
            Sheets("ASSURANCE").Range("B663:C692").Copy Sheets(sh).Range("B663")
            Sheets("ASSURANCE").Range("B696:C725").Copy Sheets(sh).Range("B696")
            Sheets("ASSURANCE").Range("B729:C758").Copy Sheets(sh).Range("B729")
            Sheets("ASSURANCE").Range("B762:C791").Copy Sheets(sh).Range("B762")
            Sheets("ASSURANCE").Range("B795:C824").Copy Sheets(sh).Range("B795")
            Sheets("ASSURANCE").Range("B828:C857").Copy Sheets(sh).Range("B828")
            Sheets("ASSURANCE").Range("B861:C890").Copy Sheets(sh).Range("B861")
            Sheets("ASSURANCE").Range("B894:C923").Copy Sheets(sh).Range("B894")
            Sheets("ASSURANCE").Range("B927:C956").Copy Sheets(sh).Range("B927")
            Sheets("ASSURANCE").Range("B960:C989").Copy Sheets(sh).Range("B960")
     
            Sheets("ASSURANCE").Range("B993:C1022").Copy Sheets(sh).Range("B993")
            Sheets("ASSURANCE").Range("B1026:C1055").Copy Sheets(sh).Range("B1026")
            Sheets("ASSURANCE").Range("B1059:C1088").Copy Sheets(sh).Range("B1059")
            Sheets("ASSURANCE").Range("B1092:C1121").Copy Sheets(sh).Range("B1092")
            Sheets("ASSURANCE").Range("B1125:C1154").Copy Sheets(sh).Range("B1125")
            Sheets("ASSURANCE").Range("B1158:C1187").Copy Sheets(sh).Range("B1158")
            Sheets("ASSURANCE").Range("B1191:C1220").Copy Sheets(sh).Range("B1191")
            Sheets("ASSURANCE").Range("B1224:C1253").Copy Sheets(sh).Range("B1224")
            Sheets("ASSURANCE").Range("B1257:C1286").Copy Sheets(sh).Range("B1257")
            Sheets("ASSURANCE").Range("B1290:C1319").Copy Sheets(sh).Range("B1290")
     
     
            Sheets("ASSURANCE").Range("B1323:C1352").Copy Sheets(sh).Range("B1323")
            Sheets("ASSURANCE").Range("B1356:C1385").Copy Sheets(sh).Range("B1356")
            Sheets("ASSURANCE").Range("B1389:C1418").Copy Sheets(sh).Range("B1389")
            Sheets("ASSURANCE").Range("B1422:C1451").Copy Sheets(sh).Range("B1422")
            Sheets("ASSURANCE").Range("B1455:C1484").Copy Sheets(sh).Range("B1455")
            Sheets("ASSURANCE").Range("B1488:C1517").Copy Sheets(sh).Range("B1488")
            Sheets("ASSURANCE").Range("B1521:C1550").Copy Sheets(sh).Range("B1521")
            Sheets("ASSURANCE").Range("B1554:C1583").Copy Sheets(sh).Range("B1554")
            Sheets("ASSURANCE").Range("B1587:C1616").Copy Sheets(sh).Range("B1587")
            Sheets("ASSURANCE").Range("B1620:C1649").Copy Sheets(sh).Range("B1620")
     
        Next sh
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"     
            ActiveWorkbook.Save
    End Sub

  2. #2
    Expert éminent sénior
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Private Sub CommandButton2_Click()
     Dim sh As String, i As Long
        Application.ScreenUpdating = 0
        For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
            For i = 3 To 1620 Step 33
                Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy Sheets(sh).Range("B" & i)
            Next i
        Next sh
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"     
        ActiveWorkbook.Save
    End Sub


    Avoir utilisé des numéros pour tes noms d'onglets (01, 02, 03, etc.) t'aurait évité ce long Array et sans doute facilité les traitements futurs.
    Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion.

  3. #3
    Futur Membre du Club
    Citation Envoyé par Menhir Voir le message
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Private Sub CommandButton2_Click()
     Dim sh As String, i As Long
        Application.ScreenUpdating = 0
        For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
    End Sub

    Rebonjour
    merci infiniment Menhir
    j'ai cette erreurs

  4. #4
    Membre expert
    Bonjour à tous,

    remet ton
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    Dim sh
    tout court, qu'il soit Variant.
    eric

  5. #5
    Futur Membre du Club
    Citation Envoyé par Menhir Voir le message
    [CODE]Private Sub CommandButton2_Click()
    remet ton
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    Dim sh
    tout court, qu'il soit Variant.
    eric
    Bonjour à tous,
    Mémé si je mais next sur ce code
    j'ai cette erreur

    Merci

  6. #6
    Membre expert
    Oui, on ne peut qu'être d'accord avec lui.
    Pas toi ?

  7. #7
    Futur Membre du Club
    Citation Envoyé par eriiic Voir le message
    Oui, on ne peut qu'être d'accord avec lui.
    Pas toi ?
    re;
    j'ai pas compris

  8. #8
    Membre expérimenté
    Bonjour,

    Pour peut-être clore ce dialogue de sourds, le code corrigé
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Private Sub CommandButton2_Click()
     Dim sh As Variant, i As Long
        Application.ScreenUpdating = 0
        For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
            For i = 3 To 1620 Step 33
                Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy Sheets(sh).Range("B" & i)
            Next i
        Next sh
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"     
        ActiveWorkbook.Save
    End Sub

  9. #9
    Rédacteur

    Bonjour,
    j'ai pas compris
    Cela signifie qu'il n'y a pas de Next et également qu'il n'y a pas de End If et donc à force de ne pas fermer convenablement les boucles ou les structures conditionnelles, un message non explicite est possible
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Quelques contributions : USERFORM - Créer, Consulter, Modifier et Supprimer des enregistrements à l'aide d'un formulaire - Géolocalisation d'une adresse avec Excel et Google sans VBA

  10. #10
    Futur Membre du Club
    Citation Envoyé par Menhir Voir le message
    Bonjour,
    Citation Envoyé par eriiic Voir le message
    Bonjour à tous,]
    Citation Envoyé par Philippe Tulliez Voir le message
    Bonjour,
    bonjour forum

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
     
    Private Sub CommandButton1_Click()
    Dim Nom$
     If RNHB.ListIndex = -1 Then MsgBox "Vous devez Sélectionner un mois avant de pouvoir transférer!!", , "Manque de choix": Exit Sub
        Application.ScreenUpdating = 0
     
                For i = 3 To 1620 Step 33
                Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy Sheets(C1.Value).Range("B" & i)
     
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"
            ActiveWorkbook.Save
    End Sub


    Se code et lier avec cette combobox

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    Private Sub Workbook_Open()
        Dim sh
        Feuil19.RNHB.Clear
        For Each sh In Array("ASSURANCE", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
            Feuil19.RNHB.AddItem sh
        Next sh	
    End Sub


    a la fin du macro je trouve devant moi cette erreur

  11. #11
    Expert éminent
    Bonjour,

    Ou encore avec l'objet Worksheet ce qui à mon sens est bien plus propre et sans équivoque :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
     
    Private Sub CommandButton2_Click()
     
        Dim sh As Worksheet
        Dim i As Long
     
        Application.ScreenUpdating = 0
     
        For Each sh In Worksheets(Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT"))
     
            For i = 3 To 1620 Step 33
                Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy sh.Range("B" & i)
            Next i
     
        Next sh
     
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"
     
        ActiveWorkbook.Save
     
    End Sub

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
     
    Private Sub Workbook_Open()
     
        Dim sh As Worksheet
     
        Feuil19.RNHB.Clear
     
        For Each sh In Worksheets(Array("ASSURANCE", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT"))
            Feuil19.RNHB.AddItem sh.Name
        Next sh
     
    End Sub

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
     
    Private Sub CommandButton1_Click()
     
        Dim Nom$
        Dim I As Integer
     
        If RNHB.ListIndex = -1 Then MsgBox "Vous devez Sélectionner un mois avant de pouvoir transférer!!", , "Manque de choix": Exit Sub
        Application.ScreenUpdating = 0
     
        For I = 3 To 1620 Step 33
            Sheets("ASSURANCE").Range("B" & I & ":C" & (I + 29)).Copy Sheets(RNHB.List(RNHB.ListIndex)).Range("B" & I)
        Next I
     
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"
     
        ActiveWorkbook.Save
     
    End Sub

  12. #12
    Futur Membre du Club
    Citation Envoyé par Theze Voir le message
    Bonjour,
    Re Forum
    Merci infiniment tous marcher très bien.
    J'ai un petit problème avec le code ça marche trop long ,il dépasser 3 minute pour transférer les donnée.
    Est il possible de régler ce problème.

###raw>template_hook.ano_emploi###