XL 2021 Listing Album Panini

[Sydneysyd666]

Bonjour

Je suis en train de liste mes images Panini pour des échanges.

J'ai donc fait un album par feuille, une feuille de total qui se décompte en fonction des quantités demandées.

Et je suis bloqué pour générer un bon de commande car je n'y connais rien !

J'ai essayé avec l'IA qui me donne ce code :

"
Sub GenererBonDeCommande()

Dim wsCommande As Worksheet
Set wsCommande = ThisWorkbook.Sheets("Bon de commande")

' Efface les anciennes données
wsCommande.Cells.Clear
wsCommande.Range("A1:C1").Value = Array("Album", "Numéro", "Quantité voulue")

Dim ws As Worksheet
Dim ligneCommande As Long
ligneCommande = 2

For Each ws In ThisWorkbook.Sheets
' Ignore les feuilles "Totaux disponibles" et "Bon de commande"
If ws.Name <> "Totaux disponibles" And ws.Name <> "Bon de commande" Then

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

Dim i As Long
For i = 2 To lastRow
Dim quantiteVoulue As Double
On Error Resume Next
quantiteVoulue = CDbl(ws.Cells(i, 4).Value) ' Colonne D
On Error GoTo 0

If quantiteVoulue > 0 Then
wsCommande.Cells(ligneCommande, 1).Value = ws.Name
wsCommande.Cells(ligneCommande, 2).Value = ws.Cells(i, 1).Value ' Colonne A = Numéro
wsCommande.Cells(ligneCommande, 3).Value = quantiteVoulue
ligneCommande = ligneCommande + 1
End If
Next i

End If
Next ws

MsgBox "Bon de commande généré avec succès !", vbInformation

End Sub"

Mais le nombre d'exemplaire n'est pas récupéré...

Merci d'avance pour votre aide et vos explications 🙂

 

[job75]

Bonjour Sydneysyd666, bienvenue sur XLD,

Avec le fichier fourni vous devez remplacer :

            derLig = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            For i = 2 To derLig
                If IsNumeric(ws.Cells(i, 3).Value) Then
                    If ws.Cells(i, 3).Value > 0 Then
                        ' Ajouter au bon de commande
                        wsCommande.Cells(ligneCommande, 1).Value = nomAlbum
                        wsCommande.Cells(ligneCommande, 2).Value = ws.Cells(i, 1).Value
                        wsCommande.Cells(ligneCommande, 3).Value = ws.Cells(i, 3).Value
                        ligneCommande = ligneCommande + 1
                        
                        ' Incrémenter le total pour l’album
                        totalAlbum = totalAlbum + ws.Cells(i, 3).Value
                    End If
                End If
            Next i

par :

            derLig = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
            
            For i = 2 To derLig
                If IsNumeric(ws.Cells(i, 4).Value) Then
                    If ws.Cells(i, 4).Value > 0 Then
                        ' Ajouter au bon de commande
                        wsCommande.Cells(ligneCommande, 1).Value = nomAlbum
                        wsCommande.Cells(ligneCommande, 2).Value = ws.Cells(i, 2).Value
                        wsCommande.Cells(ligneCommande, 3).Value = ws.Cells(i, 4).Value
                        ligneCommande = ligneCommande + 1
                        
                        ' Incrémenter le total pour l’album
                        totalAlbum = totalAlbum + ws.Cells(i, 4).Value
                    End If
                End If
            Next i

A+

 

[Sydneysyd666]

Génial ! Merci beaucoup 🙂

J'aurais aimé avoir une petite explication sur l'erreur.

De ce que je comprends, c'est la macro qui ne démarrait pas à la bonne cellule ?

 

[job75]

La macro traitait les colonnes A B C de la feuille source "2022 - MOTO GP".

Alors qu'il faut traiter les colonnes B C D.

 

[Valtrase]

Bonjour à tous,
Petit exemple en utilisant des tableaux structurés.
Pour l'exemple j'ai regroupé les années dans un seul tableau. Mais il est possible en dé-commentant les lignes de codes du module Current de boucler sur l'ensemble de tableaux.
Les prérequis :

• Les tableaux des feuilles MOTOS GP doivent être nommés selon cet exemple "vt_Pamimi2022" ou "vt_ListesRevues" dans mon exemple.
• Donner un nom de code aux feuilles. (Voir exemple dans l'environnement VBE)
• Ne pas modifier les nom et portées des champs nommés. Vous pouvez en ajouter.

Voilà je n'ai pas tout tester, j'attends vos retours.

Bonne programmation.

 

[job75]

Si l'on veut améliorer le code je préconise de mettre dans le code de la feuille TOTAUX :

Private Sub WorkSheet_Activate()
Dim lig&, w As Worksheet, s&
Application.ScreenUpdating = False
Range("A2:B" & Rows.Count).ClearContents 'RAZ
lig = 2
For Each w In Worksheets
    If UCase(w.Name) <> "TOTAUX" And UCase(w.Name) <> "BON DE COMMANDE" Then
        s = Application.Sum(w.Columns(4))
        If s Then
            Cells(lig, 1) = w.Name
            Cells(lig, 2) = s
            lig = lig + 1
        End If
    End If
Next
Columns(1).AutoFit 'ajustement largeur
End Sub

et dans le code de la feuille BON DE COMMANDE :

Private Sub WorkSheet_Activate()
Dim lig&, w As Worksheet, c As Range
Application.ScreenUpdating = False
Range("A2:C" & Rows.Count).ClearContents 'RAZ
lig = 2
On Error Resume Next 'si aucune SpecialCell
For Each w In Worksheets
    If UCase(w.Name) <> "TOTAUX" And UCase(w.Name) <> "BON DE COMMANDE" Then
        For Each c In w.Columns(4).SpecialCells(xlCellTypeConstants, 1)
            If Not c Is Nothing Then
                Cells(lig, 1) = w.Name
                Cells(lig, 2) = c(1, -1)
                Cells(lig, 3) = c
                lig = lig + 1
             End If
        Next c
    End If
Next w
Columns(1).AutoFit 'ajustement largeur
End Sub

Chacune de ces 2 macros se déclenche automatiquement quand on active la feuille où elle se trouve.