Macro VBA et liste déroulante devenue VIDE

Bonsoir,

Je suis nouveau sur ce forum.

Je travaille sur la version EXCEL 2016.

J'ai crée une macro dans laquelle je vais vérifier sur différentes sheets (onglets), si une case particulière est vide ou non : si elle est vide, je ne fais rien, sinon j'ai tout un bloc de code à lancer.

La case où je vérifie si c'est vide ou non, est une liste déroulante. Je ne la modifie pas, je vérifie juste sa valeur, cette case ne me sert que de condition. (fonction IsEmpty() )

Une autre personne a essayé mon code, et il semblerait que certaines listes déroulantes sautent. Sachant que je n'y touche pas dans mon code, que je ne modifie rien, cela ne doit sûrement pas venir du code (ou alors cela l'aurait fait sur toutes les cellules et pas que certaines).

J'ai donc pensé que cela dépendait peut être de la version excel, que cela pouvait être lié.

Sinon je vous avouerais que je suis perdu, je ne vois pas ce qui pourrait clocher. D'un côté, si le problème venait de ma macro, toutes les cellules auraient dû être affectées. Mais à part le code je ne vois pas ce qui pourrait être gênant.

Qu'en pensez vous ?

Merci d'avance pour votre réponse,

Si vous avez besoin, je peux vous passer mon code.

Bonsoir,

Merci de joindre le fichier avec le code en question et explique la partie du code qui ne marche pas. Et là, on pourra te donner des conseils.

Raja a écrit :

Bonsoir,

Merci de joindre le fichier avec le code en question et explique la partie du code qui ne marche pas. Et là, on pourra te donner des conseils.

Bonsoir,

Sub recuperation_info()

Dim s As Integer
Dim c As Integer
Dim i As Integer
Dim depart As Integer

'Worksheets("CODE ARTICLE").Range("A17:T849").ClearContents
'Worksheets("CODE ARTICLE").Range("X17:Z849").ClearContents
Worksheets("CODE ARTICLE").Range("A18:T849").Borders(xlInsideHorizontal).Weight = xlThin

depart = 17
k = 0
' boucle sur les onglets numéro 2 à 14
For s = 2 To 14

    ' boucle sur les colonnes numéro 11 à 18 (K à R)
    For c = 11 To 18

        ' boucle sur les offres 1 à 8
        If (s = 2 Or s = 3 Or s = 5 Or s = 6 Or s = 7 Or s = 9) Then
            ligne = 61
        ElseIf (s = 14) Then
            ligne = 42
        ElseIf (s = 4 Or s = 8) Then
            ligne = 63
        ElseIf (s = 10 Or s = 11 Or s = 13) Then
            ligne = 62
        Else
            ligne = 64
        End If

            For i = 2 To 9

            If IsEmpty(Sheets(s).Cells(ligne, c)) = True Then

                Range("A" & depart & ":L" & depart) = Empty
                ' si offre est vide alors la ligne sera vide

            Else
                Cells(depart, 24) = s
                Cells(depart, 25) = c
                Cells(depart, 26) = ligne

                ' si l'offre n'est pas vide alors on récupère les infos
                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Cells(depart, 1) = "AUTRES"
                ElseIf Left(Sheets(s).Cells(ligne, c).Value, 7) = "GIFT S+" Then
                    Cells(depart, 1) = "SEPHORA"
                Else: Cells(depart, 1) = "AUTRES"
                End If

                Cells(depart, 3) = "MIXTE"

                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Cells(depart, 4) = "MAILING"
                ElseIf Sheets(1).Cells(8, 4) = "BRAND" And (Sheets(s).Cells(ligne, c) = "POINT" Or Sheets(s).Cells(ligne, c) = "PURCHASE DAY" _
                        Or Sheets(s).Cells(ligne, c) = "DISCOUNT" Or Sheets(s).Cells(ligne, c) = "SERVICE") Then
                            Cells(depart, 4) = "MAILING"
                ElseIf Sheets(s).Cells(ligne, c) = "DISCOUNT" And (Sheets(1).Cells(8, 4) = "INSTITUTIONAL" Or Sheets(1).Cells(8, 4) = "PROMOTIONAL" _
                        Or Sheets(1).Cells(8, 4) = "LOCAL" Or Sheets(1).Cells(8, 4) = "OTHER") Then
                            Cells(depart, 4) = "MAILING"
                Else
                    Cells(depart, 4) = "CADEAUX"

                End If

                'OK
                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Cells(depart, 5) = "-10%"
                ElseIf Sheets(1).Cells(8, 4) = "BRAND" Then
                    Cells(depart, 5) = "MARQUE"
                ElseIf Sheets(1).Cells(8, 4) = "RECURRENT BIRTHDAY" Then
                    Cells(depart, 5) = "ANNIVERSAIRE"
                ElseIf Sheets(1).Cells(8, 4) = "RECCURENT WELCOME PACK WHITE" Then
                    Cells(depart, 5) = "WP WHITE"
                ElseIf Sheets(1).Cells(8, 4) = "RECCURENT WELCOME PACK" Then
                    Cells(depart, 5) = "BIENVENUE"
                ElseIf Sheets(s).Cells(ligne, c) = "DISCOUNT" Then
                    Cells(depart, 5) = "FIDELITE"
                Else
                    Cells(depart, 5) = "DIVERS"
                End If

                If Sheets(s).Cells(ligne, c) = "GIFT S+" Or Sheets(s).Cells(ligne, c) = "GIFT NO S+" Then
                    Cells(depart, 2) = "GWP"
                Else
                    Cells(depart, 2) = "CARTE FID"

                End If

               'libelle COURT
                If IsEmpty(Sheets(s).Cells(ligne + 6, c)) Then
                    Cells(depart, 8) = " "
                Else
                    Cells(depart, 8) = Sheets(s).Cells(ligne + 6, c)
                    Cells(depart, 8).NumberFormat = Sheets(s).Cells(ligne + 6, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 7, c)) Then
                    Cells(depart, 9) = " "
                Else
                    Cells(depart, 9) = Sheets(s).Cells(ligne + 7, c)
                    Cells(depart, 9).NumberFormat = Sheets(s).Cells(ligne + 7, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 8, c)) Then
                    Cells(depart, 10) = " "
                Else
                    Cells(depart, 10) = Sheets(s).Cells(ligne + 8, c)
                    Cells(depart, 10).NumberFormat = Sheets(s).Cells(ligne + 8, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 9, c)) Then
                    Cells(depart, 11) = " "
                Else
                    Cells(depart, 11) = Sheets(s).Cells(ligne + 9, c)
                    Cells(depart, 11).NumberFormat = Sheets(s).Cells(ligne + 9, c).NumberFormat
                End If

                Cells(depart, 12) = Cells(depart, 8) & " " & Cells(depart, 9) & " " & Cells(depart, 10) & " " & Cells(depart, 11) & " " & Format(Sheets(s).Cells(ligne + 2, c), "mmyy")

                Cells(depart, 6) = "OFFRE" & " " & Right(Sheets(s).Cells(ligne, c), 2)

                If (i = 2 Or i = 3 Or i = 4) Then
                    Cells(depart, 7) = "TRAFFIC OFFER"
                Else
                    Cells(depart, 7) = "PURCHASE OFFER"
                End If

            End If
            If IsEmpty(Sheets(s).Cells(ligne, c)) = False Then
                depart = depart + 1
            End If

            If (i = 4) Then
                ligne = ligne + 21
            Else
                ligne = ligne + 20
            End If

        Next i
        Range("A" & depart & ":T" & depart).Borders(xlEdgeTop).Weight = xlThick

    Next c
Next s

' on filtre de façon à supprimer les lignes vides

End Sub

Sub recuperation_EAD()

Dim depart As Integer
Dim onglet As Integer
Dim ligne As Integer
Dim Col As Integer

depart = 17

While IsEmpty(Cells(depart, 24)) = False
    onglet = Cells(depart, 24)
    ligne = Cells(depart, 26)
    Col = Cells(depart, 25)
    Sheets(onglet).Cells(ligne + 12, Col) = Cells(depart, 13)
    Sheets(onglet).Cells(ligne + 13, Col) = Cells(depart, 14)
    depart = depart + 1
Wend

End Sub

En soit, tout fonctionne. Juste quand une autre personne a essayé de lancer le code, les liste déroulantes se situant à "Sheets(s).Cells(ligne,c)" sont parfois supprimés. Je doute que ce soit le code, sinon l'erreur se serait reproduit. De plus, je n'ai aucun problème moi sur mon ordinateur, c'est pour cela que je ne comprends pas. Le but de la première partie du code est de récupérer des informations sur les Sheets(s), et de les stocker sur la feuille active appelée "CODE ARTICLE".

Bonjour Mohamed76800, bonjour le fil, bonjour le forum,

À de nombreux endroits, tu utilises cells(....) sans mentionner la cellule de quelle feuille.

Si la macro est lancée d'une autre feuille, il peut arriver des choses bizarres tel : l'effacement de données ou l'écriture à des endroits inappropriés.

Prenons un exemple au hasard :

If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Cells(depart, 1) = "AUTRES"
...
...

Sheets(1).cells(8,4)..., là, il n'y a pas de doute possible, la feuille 1.

Mais, cells(depart, 1)= "Autres". Ici, la cellule sera la cellule de la feuille active. Il serait préférable que la feuille soit identifiée afin que l'information soit écrite dans la bonne feuille et pas ailleurs.

Pour alléger le code, on déclare une variable

Dim Sh as WorkSheet ' Sh est une feuille

Puis on attribue à Sh le nom de la feuille à représenter.

Set Sh = Worksheets("CODE ARTICLE")

Dès lors, on peut écrire : Sh.Cells(depart, 1)= "Autres", là on est sûr que ce sera la cellule de la feuille "CODE ARTICLE". Ainsi, le code n'est pas trop alourdi et sa compréhension en est améliorée.

Sub recuperation_info()

Dim s As Integer
Dim c As Integer
Dim i As Integer
Dim depart As Integer
Dim Sh As Worksheet

    'Worksheets("CODE ARTICLE").Range("A17:T849").ClearContents
    'Worksheets("CODE ARTICLE").Range("X17:Z849").ClearContents
Worksheets("CODE ARTICLE").Range("A18:T849").Borders(xlInsideHorizontal).Weight = xlThin
Set Sh = Worksheets("CODE ARTICLE")

depart = 17
k = 0
' boucle sur les onglets numéro 2 à 14
For s = 2 To 14

        ' boucle sur les colonnes numéro 11 à 18 (K à R)
    For c = 11 To 18
            ' boucle sur les offres 1 à 8
        If (s = 2 Or s = 3 Or s = 5 Or s = 6 Or s = 7 Or s = 9) Then
            ligne = 61
        ElseIf (s = 14) Then
            ligne = 42
        ElseIf (s = 4 Or s = 8) Then
            ligne = 63
        ElseIf (s = 10 Or s = 11 Or s = 13) Then
            ligne = 62
        Else
            ligne = 64
        End If

        For i = 2 To 9
            If IsEmpty(Sheets(s).Cells(ligne, c)) = True Then
                 Sh.Range("A" & depart & ":L" & depart) = Empty
                ' si offre est vide alors la ligne sera vide

            Else
                Sh.Cells(depart, 24) = s
                Sh.Cells(depart, 25) = c
                Sh.Cells(depart, 26) = ligne

                ' si l'offre n'est pas vide alors on récupère les infos
                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Sh.Cells(depart, 1) = "AUTRES"
                ElseIf Left(Sheets(s).Cells(ligne, c).Value, 7) = "GIFT S+" Then
                    Sh.Cells(depart, 1) = "SEPHORA"
                Else: Sh.Cells(depart, 1) = "AUTRES"
                End If

                Sh.Cells(depart, 3) = "MIXTE"
                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Sh.Cells(depart, 4) = "MAILING"
                ElseIf Sheets(1).Cells(8, 4) = "BRAND" And (Sheets(s).Cells(ligne, c) = "POINT" Or Sheets(s).Cells(ligne, c) = "PURCHASE DAY" _
                    Or Sheets(s).Cells(ligne, c) = "DISCOUNT" Or Sheets(s).Cells(ligne, c) = "SERVICE") Then
                    Sh.Cells(depart, 4) = "MAILING"
                ElseIf Sheets(s).Cells(ligne, c) = "DISCOUNT" And (Sheets(1).Cells(8, 4) = "INSTITUTIONAL" Or Sheets(1).Cells(8, 4) = "PROMOTIONAL" _
                    Or Sheets(1).Cells(8, 4) = "LOCAL" Or Sheets(1).Cells(8, 4) = "OTHER") Then
                    Sh.Cells(depart, 4) = "MAILING"
                Else
                    Sh.Cells(depart, 4) = "CADEAUX"
                End If

                    'OK
                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Sh.Cells(depart, 5) = "-10%"
                ElseIf Sheets(1).Cells(8, 4) = "BRAND" Then
                    Sh.Cells(depart, 5) = "MARQUE"
                ElseIf Sheets(1).Cells(8, 4) = "RECURRENT BIRTHDAY" Then
                    Sh.Cells(depart, 5) = "ANNIVERSAIRE"
                ElseIf Sheets(1).Cells(8, 4) = "RECCURENT WELCOME PACK WHITE" Then
                    Sh.Cells(depart, 5) = "WP WHITE"
                ElseIf Sheets(1).Cells(8, 4) = "RECCURENT WELCOME PACK" Then
                    Sh.Cells(depart, 5) = "BIENVENUE"
                ElseIf Sheets(s).Cells(ligne, c) = "DISCOUNT" Then
                    Sh.Cells(depart, 5) = "FIDELITE"
                Else
                    Sh.Cells(depart, 5) = "DIVERS"
                End If

                If Sheets(s).Cells(ligne, c) = "GIFT S+" Or Sheets(s).Cells(ligne, c) = "GIFT NO S+" Then
                    Sh.Cells(depart, 2) = "GWP"
                Else
                    Sh.Cells(depart, 2) = "CARTE FID"
                End If

                   'libelle COURT
                If IsEmpty(Sheets(s).Cells(ligne + 6, c)) Then
                    Sh.Cells(depart, 8) = " "
                Else
                    Sh.Cells(depart, 8) = Sheets(s).Cells(ligne + 6, c)
                    Sh.Cells(depart, 8).NumberFormat = Sheets(s).Cells(ligne + 6, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 7, c)) Then
                    Sh.Cells(depart, 9) = " "
                Else
                    Sh.Cells(depart, 9) = Sheets(s).Cells(ligne + 7, c)
                    Sh.Cells(depart, 9).NumberFormat = Sheets(s).Cells(ligne + 7, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 8, c)) Then
                    Sh.Cells(depart, 10) = " "
                Else
                    Sh.Cells(depart, 10) = Sheets(s).Cells(ligne + 8, c)
                    Sh.Cells(depart, 10).NumberFormat = Sheets(s).Cells(ligne + 8, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 9, c)) Then
                    Sh.Cells(depart, 11) = " "
                Else
                    Sh.Cells(depart, 11) = Sheets(s).Cells(ligne + 9, c)
                    Sh.Cells(depart, 11).NumberFormat = Sheets(s).Cells(ligne + 9, c).NumberFormat
                End If

                Sh.Cells(depart, 12) = Sh.Cells(depart, 8) & " " & Sh.Cells(depart, 9) & " " & Sh.Cells(depart, 10) & " " & Sh.Cells(depart, 11) & " " & Format(Sheets(s).Cells(ligne + 2, c), "mmyy")
                Sh.Cells(depart, 6) = "OFFRE" & " " & Right(Sheets(s).Cells(ligne, c), 2)

                If (i = 2 Or i = 3 Or i = 4) Then
                    Sh.Cells(depart, 7) = "TRAFFIC OFFER"
                Else
                    Sh.Cells(depart, 7) = "PURCHASE OFFER"
                End If

            End If

            If IsEmpty(Sheets(s).Cells(ligne, c)) = False Then depart = depart + 1

            If (i = 4) Then
                ligne = ligne + 21
            Else
                ligne = ligne + 20
            End If
        Next i

        Sh.Range("A" & depart & ":T" & depart).Borders(xlEdgeTop).Weight = xlThick
    Next c
Next s
    ' on filtre de façon à supprimer les lignes vides
End Sub

Sub recuperation_EAD()
Dim depart As Integer
Dim onglet As Integer
Dim ligne As Integer
Dim Col As Integer
Dim Sh As Worksheet

Set Sh = Worksheets("CODE ARTICLE")

depart = 17

While IsEmpty(Sh.Cells(depart, 24)) = False
    onglet = Sh.Cells(depart, 24)
    ligne = Sh.Cells(depart, 26)
    Col = Sh.Cells(depart, 25)
    Sheets(onglet).Cells(ligne + 12, Col) = Sh.Cells(depart, 13)
    Sheets(onglet).Cells(ligne + 13, Col) = Sh.Cells(depart, 14)
    depart = depart + 1
Wend

End Sub

Joseph

retraite8 a écrit :

Bonjour Mohamed76800, bonjour le fil, bonjour le forum,

À de nombreux endroits, tu utilises cells(....) sans mentionner la cellule de quelle feuille.

Si la macro est lancée d'une autre feuille, il peut arriver des choses bizarres tel : l'effacement de données ou l'écriture à des endroits inappropriés.

Prenons un exemple au hasard :

If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Cells(depart, 1) = "AUTRES"
...
...

Sheets(1).cells(8,4)..., là, il n'y a pas de doute possible, la feuille 1.

Mais, cells(depart, 1)= "Autres". Ici, la cellule sera la cellule de la feuille active. Il serait préférable que la feuille soit identifiée afin que l'information soit écrite dans la bonne feuille et pas ailleurs.

Pour alléger le code, on déclare une variable

Dim Sh as WorkSheet ' Sh est une feuille

Puis on attribue à Sh le nom de la feuille à représenter.

Set Sh = Worksheets("CODE ARTICLE")

Dès lors, on peut écrire : Sh.Cells(depart, 1)= "Autres", là on est sûr que ce sera la cellule de la feuille "CODE ARTICLE". Ainsi, le code n'est pas trop alourdi et sa compréhension en est améliorée.

Sub recuperation_info()

Dim s As Integer
Dim c As Integer
Dim i As Integer
Dim depart As Integer
Dim Sh As Worksheet

    'Worksheets("CODE ARTICLE").Range("A17:T849").ClearContents
    'Worksheets("CODE ARTICLE").Range("X17:Z849").ClearContents
Worksheets("CODE ARTICLE").Range("A18:T849").Borders(xlInsideHorizontal).Weight = xlThin
Set Sh = Worksheets("CODE ARTICLE")

depart = 17
k = 0
' boucle sur les onglets numéro 2 à 14
For s = 2 To 14

        ' boucle sur les colonnes numéro 11 à 18 (K à R)
    For c = 11 To 18
            ' boucle sur les offres 1 à 8
        If (s = 2 Or s = 3 Or s = 5 Or s = 6 Or s = 7 Or s = 9) Then
            ligne = 61
        ElseIf (s = 14) Then
            ligne = 42
        ElseIf (s = 4 Or s = 8) Then
            ligne = 63
        ElseIf (s = 10 Or s = 11 Or s = 13) Then
            ligne = 62
        Else
            ligne = 64
        End If

        For i = 2 To 9
            If IsEmpty(Sheets(s).Cells(ligne, c)) = True Then
                 Sh.Range("A" & depart & ":L" & depart) = Empty
                ' si offre est vide alors la ligne sera vide

            Else
                Sh.Cells(depart, 24) = s
                Sh.Cells(depart, 25) = c
                Sh.Cells(depart, 26) = ligne

                ' si l'offre n'est pas vide alors on récupère les infos
                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Sh.Cells(depart, 1) = "AUTRES"
                ElseIf Left(Sheets(s).Cells(ligne, c).Value, 7) = "GIFT S+" Then
                    Sh.Cells(depart, 1) = "SEPHORA"
                Else: Sh.Cells(depart, 1) = "AUTRES"
                End If

                Sh.Cells(depart, 3) = "MIXTE"
                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Sh.Cells(depart, 4) = "MAILING"
                ElseIf Sheets(1).Cells(8, 4) = "BRAND" And (Sheets(s).Cells(ligne, c) = "POINT" Or Sheets(s).Cells(ligne, c) = "PURCHASE DAY" _
                    Or Sheets(s).Cells(ligne, c) = "DISCOUNT" Or Sheets(s).Cells(ligne, c) = "SERVICE") Then
                    Sh.Cells(depart, 4) = "MAILING"
                ElseIf Sheets(s).Cells(ligne, c) = "DISCOUNT" And (Sheets(1).Cells(8, 4) = "INSTITUTIONAL" Or Sheets(1).Cells(8, 4) = "PROMOTIONAL" _
                    Or Sheets(1).Cells(8, 4) = "LOCAL" Or Sheets(1).Cells(8, 4) = "OTHER") Then
                    Sh.Cells(depart, 4) = "MAILING"
                Else
                    Sh.Cells(depart, 4) = "CADEAUX"
                End If

                    'OK
                If Sheets(1).Cells(8, 4) = "RECURRENT 10% VOUCHER" Then
                    Sh.Cells(depart, 5) = "-10%"
                ElseIf Sheets(1).Cells(8, 4) = "BRAND" Then
                    Sh.Cells(depart, 5) = "MARQUE"
                ElseIf Sheets(1).Cells(8, 4) = "RECURRENT BIRTHDAY" Then
                    Sh.Cells(depart, 5) = "ANNIVERSAIRE"
                ElseIf Sheets(1).Cells(8, 4) = "RECCURENT WELCOME PACK WHITE" Then
                    Sh.Cells(depart, 5) = "WP WHITE"
                ElseIf Sheets(1).Cells(8, 4) = "RECCURENT WELCOME PACK" Then
                    Sh.Cells(depart, 5) = "BIENVENUE"
                ElseIf Sheets(s).Cells(ligne, c) = "DISCOUNT" Then
                    Sh.Cells(depart, 5) = "FIDELITE"
                Else
                    Sh.Cells(depart, 5) = "DIVERS"
                End If

                If Sheets(s).Cells(ligne, c) = "GIFT S+" Or Sheets(s).Cells(ligne, c) = "GIFT NO S+" Then
                    Sh.Cells(depart, 2) = "GWP"
                Else
                    Sh.Cells(depart, 2) = "CARTE FID"
                End If

                   'libelle COURT
                If IsEmpty(Sheets(s).Cells(ligne + 6, c)) Then
                    Sh.Cells(depart, 8) = " "
                Else
                    Sh.Cells(depart, 8) = Sheets(s).Cells(ligne + 6, c)
                    Sh.Cells(depart, 8).NumberFormat = Sheets(s).Cells(ligne + 6, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 7, c)) Then
                    Sh.Cells(depart, 9) = " "
                Else
                    Sh.Cells(depart, 9) = Sheets(s).Cells(ligne + 7, c)
                    Sh.Cells(depart, 9).NumberFormat = Sheets(s).Cells(ligne + 7, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 8, c)) Then
                    Sh.Cells(depart, 10) = " "
                Else
                    Sh.Cells(depart, 10) = Sheets(s).Cells(ligne + 8, c)
                    Sh.Cells(depart, 10).NumberFormat = Sheets(s).Cells(ligne + 8, c).NumberFormat
                End If

                If IsEmpty(Sheets(s).Cells(ligne + 9, c)) Then
                    Sh.Cells(depart, 11) = " "
                Else
                    Sh.Cells(depart, 11) = Sheets(s).Cells(ligne + 9, c)
                    Sh.Cells(depart, 11).NumberFormat = Sheets(s).Cells(ligne + 9, c).NumberFormat
                End If

                Sh.Cells(depart, 12) = Sh.Cells(depart, 8) & " " & Sh.Cells(depart, 9) & " " & Sh.Cells(depart, 10) & " " & Sh.Cells(depart, 11) & " " & Format(Sheets(s).Cells(ligne + 2, c), "mmyy")
                Sh.Cells(depart, 6) = "OFFRE" & " " & Right(Sheets(s).Cells(ligne, c), 2)

                If (i = 2 Or i = 3 Or i = 4) Then
                    Sh.Cells(depart, 7) = "TRAFFIC OFFER"
                Else
                    Sh.Cells(depart, 7) = "PURCHASE OFFER"
                End If

            End If

            If IsEmpty(Sheets(s).Cells(ligne, c)) = False Then depart = depart + 1

            If (i = 4) Then
                ligne = ligne + 21
            Else
                ligne = ligne + 20
            End If
        Next i

        Range("A" & depart & ":T" & depart).Borders(xlEdgeTop).Weight = xlThick
    Next c
Next s
    ' on filtre de façon à supprimer les lignes vides
End Sub

Sub recuperation_EAD()
Dim depart As Integer
Dim onglet As Integer
Dim ligne As Integer
Dim Col As Integer
Dim Sh As Worksheet

Set Sh = Worksheets("CODE ARTICLE")

depart = 17

While IsEmpty(Sh.Cells(depart, 24)) = False
    onglet = Sh.Cells(depart, 24)
    ligne = Sh.Cells(depart, 26)
    Col = Sh.Cells(depart, 25)
    Sheets(onglet).Cells(ligne + 12, Col) = Sh.Cells(depart, 13)
    Sheets(onglet).Cells(ligne + 13, Col) = Sh.Cells(depart, 14)
    depart = depart + 1
Wend

End Sub

Joseph

Bonjour,

Merci pour votre réponse détaillée.

Je vais effectuer votre modification mais il me semblait que j'avais bien considéré que la feuille active était "CODE ARTICLE". Le problème ne se situe pas dans les données reportées dans la page active ie. CODE ARTICLE, jusque là, tout se passe bien. C'est lorsque je vérifie des conditions sur mes " Sheets(s).Cells(ligne,c)" qu'il y aurait apparemment des problèmes. Les Sheets(s).Cells(ligne,c) correspondent en général à des listes déroulantes. Et dans mon code, je ne les modifie pas, je m'en sers juste en tant que condition, donc je n'arrive pas à comprendre qu'elles puissent être modifiées.

Bonjour Mohamed76800, bonjour le fil, bonjour le forum,

Faute de fichier sur lequel tester, puis-je avoir les adresses de quelques cellules qui contiennent des listes déroulantes ?

Joseph

retraite8 a écrit :

Bonjour Mohamed76800, bonjour le fil, bonjour le forum,

Faute de fichier sur lequel tester, puis-je avoir les adresses de quelques cellules qui contiennent des listes déroulantes ?

Joseph

Bonjour !

Je peux vous envoyer le fichier si vous le souhaitez mais cela va nécessiter des explications d'utilisation.

Les cellules contenant des listes déroulantes sont les cellules Sheets(s).Cells(ligne,c)

Mais dans mon code elles ne servent que de conditions. Quelques exemples où cela avait sauté : K81 L81 (sur la Sheets(2).Cells(81,11) et Sheets(2).Cells(81,12)).

Enfaite, le référencement à la base de ces cellules est : Nomenclature!A$57:A$63

Quand elles sautent, on remarque que leur nouvel référencement est : A$40:A$46

Donc je ne comprends pas, car on ne modifie pas la source de la liste mais elle semble se modifier seule.

Avez vous une idée?

Au passage, les gens qui ont utilisé mon fichier utilisent EXCEL 2013 et moi 2016.

Bonjour Mohamed76800, bonjour le fil, bonjour le forum,

Il y a ici ... où des cellules sont vidées. (code d'origine)

For i = 2 To 9
            If IsEmpty(Sheets(s).Cells(ligne, c)) = True Then
                 Range("A" & depart & ":L" & depart) = Empty
                ' si offre est vide alors la ligne sera vide

Sans référencement des feuilles sur lesquelles travailler et une possible confusion du code sur le numéro des feuilles (For s = 2 To 14 ... ), je crois que cela explique les problèmes.

Il y a aussi à vérifier le numéro des feuilles et leurs noms (voir dans VBE dans la colonne de gauche)

Exemple : Feuil15(Nomenclature).

Le code utilise les numéros de feuille de 2 à 14.

Une fois le code, tout au long, bien référencé sur quelle feuille le traitement doit se faire, il n'y aura plus les changements non désirés.

Teste avec les changements dans le code.

Joseph

Merci pour vos aides, tout fonctionne correctement maintenant.

J'ai un nouveau problème, je vous le soumets.

Public Function IsPos(onglet As Integer, colonne As Integer, ligne As Integer, Sh As Worksheet) As Boolean

Dim ligne_depart As Integer

Dim onglet_start As String

ligne_depart = 17

onglet_start = Sh.Cells(ligne_depart, 24)

IsPos = False

While (IsEmpty(onglet_start) = False)

If (onglet = Sh.Cells(ligne_depart, 24) And colonne = Sh.Cells(ligne_depart, 25) And ligne = Sh.Cells(ligne_depart, 26)) Then

IsPos = True

Exit Function

End If

ligne_depart = ligne_depart + 1

onglet_start = Sh.Cells(ligne_depart, 24)

'Sh.Cells(ligne_depart, 22) = onglet_start

Wend

End Function

Sub Main()

Dim Sh As Worksheet

Dim Bool As Boolean

Set Sh = Worksheets("CODE ARTICLE")

Bool = IsPos(2, 11, 120, Sh)

MsgBox Bool

End Sub

Le but de se code est de vérifier que ce qui est en entrée de notre fonction f(onglet,colonne,ligne) appartient bien aux valeurs des colonnes X Y Z.

X représentant la valeur de l'onglet, Y la valeur de la colonne et Z la valeur de la ligne.

Lorsque la position en entrée de la fonction existe bel et bien dans nos trois colonnes, on renvoie bien "vraie" mais lorsque la position n'y est pas, nous avons un "dépassement de capacité" et on ne sort pas de la boucle while. On incrémente sans arrêt.

Ce que je ne comprends pas c'est que j'ai l'impression que la fonction IsEmpty fait mal son travail.

Lorsque j'ai déclaré "onglet_start" comme un entier, j'ai l'impression qu'il a considéré le vide comme un "0".

Merci d'avance pour votre aide

Bonjour Mohamed76800, bonjour le fil, bonjour le forum,

Quand tu soumets du code, s.t.p. penses à utiliser le bouton Code pour mettre le code entre balise afin qu'il soit plus lisible.

Le dépassement de pile provient qu'il teste indéfiniment des lignes : ligne_depart = ligne_depart +1

Il faut imposer une limite. Dans ce cas, on va utiliser la dernière ligne de la colonne 24 (ref.: Sh.Cells(ligne_depart, 24) ) et sortir de la Function si la limite est atteinte.

Option Explicit

Public Function IsPos(onglet As Integer, colonne As Integer, ligne As Integer, Sh As Worksheet) As Boolean

Dim ligne_depart As Integer
Dim onglet_start As String
Dim DerLig As Integer    ''Ajout ICI

DerLig = Sh.Cells(Rows.Count).End(xlUp).Row  ''Ajout ICI
ligne_depart = 17
onglet_start = Sh.Cells(ligne_depart, 24)
IsPos = False
While (IsEmpty(onglet_start) = False)
    If (onglet = Sh.Cells(ligne_depart, 24) And colonne = Sh.Cells(ligne_depart, 25) And ligne = Sh.Cells(ligne_depart, 26)) Then
        IsPos = True
        Exit Function
    End If
    ligne_depart = ligne_depart + 1
    If ligne_depart > DerLig Then Exit Function    ''Ajout ICI
    onglet_start = Sh.Cells(ligne_depart, 24)
            'Sh.Cells(ligne_depart, 22) = onglet_start
Wend
End Function

Sub Main()

Dim Sh As Worksheet
Dim Bool As Boolean

Set Sh = Worksheets("CODE ARTICLE")
Bool = IsPos(2, 11, 120, Sh)
MsgBox Bool

End Sub

Joseph

Désolé j'ai oublié d'utiliser CODE.

Le problème est qu'il y a bien une limite enfaite.

On devrait arriver à quelque chose de vide, il reste bel et bien piégé dans la boucle.

Cette condition est vérifiée normalement mais on dirait qu'il ne la considère pas.

J'ai finalement, au lieu d'utiliser IsEmpty, utilisé la condition While (onglet_start <> 0)

et là cela fonctionne ...

Bonjour Mohamed76800, bonjour le forum,

Excuse-moi, je suis un peu fatigué et je ne réfléchis pas bien. Je vais devoir me procurer un miroir pour améliorer cela.

Ceci pourrait aider, https://support.office.com/fr-fr/article/IsEmpty-fonction-a86d5871-f6bd-455c-9256-a69a42e55e50 .

Joseph

Merci pour votre aide .

Une dernière petite question :

Sh.Cells(depart, 8) = Sheets(s).Cells(ligne + 6, c)
                    Sh.Cells(depart, 8).NumberFormat = Sheets(s).Cells(ligne + 6, c).NumberFormat

J'ai utilisé .NumberFormat pour conserver les pourcentage lors de la copie. Et cela marche bien ponctuellement.

Néanmoins, lorsque j'ai souhaité faire cela :

Sh.Cells(depart, 12) = Sh.Cells(depart, 8) & " " & Sh.Cells(depart, 9) & " " & Sh.Cells(depart, 10) & " " & Sh.Cells(depart, 11) & " " & Format(Sheets(s).Cells(ligne + 2, c), "mmyy")

J'ai reperdu mes pourcentages.

J'ai essayé d'ajouter ".NumberFormat" à tout. Mais sans succès..

Bonjour Mohamed76800, bonjour le forum,

Désolé pour le délai, j'étais occupé sur un autre projet.

Peux-tu me rappeler quelles cellules ont, ou devraient avoir, des pourcentages ?

Joseph

Bonjour,

Pas de soucis !

Ben lorsque je récupère des informations, et que je les colle dans la cellule correspondant à la ligne depart, colonne 8, j'ai bien des pourcentages grâce à .NumberFormat.

Mais lorsque je veux récupérer les informations de la colonne 8, ligne 6 pour les mettre dans la cellule correspondant à la ligne depart, colonne 12, il ne me conserve pas les pourcentages.

Bonjour,

avec :

Sh.Cells(depart, 12) = Sh.Cells(depart, 8) & " " & Sh.Cells(depart, 9) & " " & Sh.Cells(depart, 10) & " " & Sh.Cells(depart, 11) & " " & Format(Sheets(s).Cells(ligne + 2, c), "mmyy")

tu fabriques une chaine.

Un format Nombre ne s'applique qu'à ... un nombre.

Met ton % dans la chaine en utilisant Format() là où il faut.

eric

Bonjour,

merci pour la réponse.

Le problème est que je ne suis pas sensé savoir qu'il y a un pourcentage dans cette cellule.

Je veux pouvoir traiter le cas où il y aurait un pourcentage et le cas où non du coup.

L'idéal serait peut être de tout convertir en string non?

Je vous avouerais que je sèche un peu sur le problème.

Bonjour,

pour faire simple tu peux utiliser

Sh.Cells(depart, 8).text

Tu auras strictement ce qui est affiché dans la cellule.

Mais y compris si tu perds des décimales car tu as réduis ta largeur de colle, voire même les ## affichés si la colonne est beaucoup trop réduite.

Sinon il faut tester le format de la cellule .NumberFormat et fabriquer ta chaine en fonction.

eric

edit : mis les balises code pour éviter le : 8) du 8 )

Bonjour Mohamed76800, bonjour le fil, bonjour le forum,

Si les cellules sources concernées sur les feuilles 2 à 14 sont au format % (même avec décimales) et que les cellules cibles de la feuille "Code Article" sont au format Standard, je suis arrivé à la chose que eriiic, les .Text fonctionnent bien.

Sh.Cells(depart, 12) = Sh.Cells(depart, 8).Text & " " & Sh.Cells(depart, 9).Text & " " & Sh.Cells(depart, 10).Text & " " & Sh.Cells(depart, 11).Text & " " & Format(Sheets(s).Cells(ligne + 2, c), "mmyy")
mohamed

Joseph

Merci pour votre réponse.

Finalement, j'ai créer une fonction IsPercent(worsheet,ligne,colonne) permettant de savoir si il y a un pourcent ou non.

Selon le cas, je ferais un traitement particulier :

Public Function IsPercent(Sh As Worksheet, ligne As Integer, colonne As Integer) As Boolean

IsPercent = False
Dim pcMyFormat As Variant

     'substitute the range here for the target cell of your variable
pcMyFormat = Cells(ligne, colonne).NumberFormat

If pcMyFormat = "0%" Then
    IsPercent = True
    Exit Function
Else
    IsPercent = False
    Exit Function
End If

End Function
                If IsPercent(Sh, depart, 8) = True Then
                    Sh.Cells(depart, 12) = Format(Sh.Cells(depart, 8), "Percent")
                Else
                    Sh.Cells(depart, 12) = Sh.Cells(depart, 8)
                End If
Rechercher des sujets similaires à "macro vba liste deroulante devenue vide"