Modification code

bonjour,

j'utilise le tableau ci-dessous pour le gestion de Bon de Commande.

Je saisi les infos de mon BC dans la feuille "tableau suivi ", et lorsqu'il est validé (colonne O ou P cochée), je clic sur le bouton ventilation.

A ce moment la, la ligne est transférée sur une nouvelle feuille du classeur, qui portera le nom du fournisseur dont le nom figure en colonne F.

https://www.excel-pratique.com/~files/doc2/Suivi_Bc_2009.xls

Ce sur quoi j'ai besoin d'aide dans le code VBA:

• suppression de la colonne A (cela peut paraître simple, mais cette suppression décale les colonnes, ce qui fait que les codes ne fonctionnent plus correctement)
• classification des lignes transférées par ordre d'arrivé selon la date (dernière ligne=date la + récente)

J'espère que vous pourrez m'aider

Merci d'avance

Petu

Bonsoir,

Même remarque que sur ton autre fil,

https://www.excel-pratique.com/forum/viewtopic.php?t=14055

où est la macro en question ?

Envoie-là pour la modifier

Amicalement

Claude.

re,

Pour l'ajout de ligne

Sub insere_ligne()
Dim DerLig As Long
Application.ScreenUpdating = False
DerLig = [A65000].End(xlUp).Row
    Rows(DerLig & ":" & DerLig).Copy
    Rows(DerLig & ":" & DerLig).Insert Shift:=xlDown
    Rows(DerLig + 1 & ":" & DerLig + 1).ClearContents
Cells(DerLig + 1, 1).Value = Cells(DerLig, 0).Value + 0
End Sub

Pour le bouton ventilation

Sub ventile()
Application.ScreenUpdating = False
Set MesFournisseurs = CreateObject("Scripting.Dictionary") 'création du objet Dictionary
DCell = Sheets("Tableau suivi").Range("N1:O65000").Find("*", , , , xlByRows, xlPrevious)(1).Row
    'On détermine la dernière ligne non vide des colonnes N et O
With Sheets("Tableau suivi").Range("N4:O" & DCell) 'Dans l'onglet "Tableau Suivi" de la cellule
                                                    ' N4 à O et dernière ligne
    For Each cel In .SpecialCells(xlCellTypeConstants, 23) 'pour toutes les cellules comportant
                                                            'une constante (donc non vides)
        If Not MesFournisseurs.Exists(cel.Row) Then  'si le numéro de ligne n'est pas dans
                                                        'l'objet Dictionary
        MesFournisseurs.Add cel.Row, cel.Row        'on l'ajoute
        If Len(Cells(cel.Row, 6).Value) > 31 Then
            NomFeuille = Left(Cells(cel.Row, 6).Value, 31)
        Else
            NomFeuille = Cells(cel.Row, 6).Value
        End If

        On Error Resume Next                        'on supprime la gestion des erreurs
        Set connue = Sheets(NomFeuille) 'on détermine si la feuille du fournisseur existe
            If Err <> 0 Then                        ' si on a une erreur (la feuille n'existe donc pas)
                Sheets.Add after:=Sheets(Sheets.Count) 'on ajoute une feuille à la fin
                ActiveSheet.Name = NomFeuille 'on lui donne le nom du fournisseur
                ActiveWindow.Zoom = 75      'on met le zoom à 75%
                Sheets("Tableau suivi").Select  'on revient sur le premier onglet
                Rows(3).Copy Sheets(NomFeuille).[A1] 'on copie les en-têtes
                For i = 1 To 15     'et on règle la largeur des colonnes comme dans le premier
                    Sheets(NomFeuille).Columns(i).ColumnWidth = Columns(i).ColumnWidth
                Next i
            End If
        On Error GoTo 0 'on remet la gestion des erreurs
            With Sheets(NomFeuille) 'avec la feuille "Fournisseur"
                DerLig = .[A65000].End(xlUp).Row + 1    'on calcule la première cellule vide de la colonne A
                Rows(cel.Row).Copy .Cells(DerLig, 1)    'on copie la ligne concernée dans la feuille "Fournisseur"
                .Columns("A:P").Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess
                        'on fait le tri selon le numéro
            End With
        End If
    Next cel
End With
On Error Resume Next 'Ici, on va supprimer toutes les lignes qui contiennent une constante
                        'dans les colonnes O ou P
Sheets("Tableau suivi").Range("O4:O" & DCell + 1).SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete
Sheets("Tableau suivi").Range("P4:P" & DCell + 1).SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete
On Error GoTo 0
End Sub

Pour le lien recap (feuille Recap)

Sub lienRécap()
'sélection de la feuille Récap
Dim i As Worksheet
Dim f As String
Dim j As Byte
Dim n
Application.ScreenUpdating = False
  For n = 3 To Sheets.Count
     For j = n To Sheets.Count
        If UCase(Sheets(j).Name) < UCase(Sheets(n).Name) Then
          Sheets(n).Move before:=Sheets(j)
          Sheets(j).Move before:=Sheets(n)
        End If
     Next j
  Next n

  Sheets("Recap").Select
   Range("c3").Select
  For Each i In ActiveWorkbook.Sheets
    f = i.Name
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & f & "'" & "!A1", TextToDisplay:=f
    ActiveCell.Offset(1, 0).Select
  Next i
End Sub

J'espère avoir tout mis, je te remercie pour ton aide

Petu

re,

j'ai en parti résolu mon problème (suppression colonne A)

https://www.excel-pratique.com/~files/doc2/j7uuhSuivi_Bc_2009.xls

Maintenant, je vais poser une autre question:

à partir du code ci-dessous, comment faire apparaître dans les cellules de la colonne A (date) la date du jour, et non pas la date de la ligne précédente +1?

Sub insere_ligne() 
Dim DerLig As Long 
Application.ScreenUpdating = False 
DerLig = [A65000].End(xlUp).Row 
    Rows(DerLig & ":" & DerLig).Copy 
    Rows(DerLig & ":" & DerLig).Insert Shift:=xlDown 
    Rows(DerLig + 1 & ":" & DerLig + 1).ClearContents 
Cells(DerLig + 1, 1).Value = Cells(DerLig, 1).Value + 1
End Sub

Merci pour votre aide

Petu