Microsoft 365 Formule excel pour recopier automatiquement une ligne dans un onglet

78stl à dit:

Bonjour,

Je suis nouvelle sur le groupe, et au vu des discussions sur le forum considérons que je débute avec Excel.
Je cherche dans un tableau Excel utilisé pour faire de la comptabilité à faire en sorte de remplir le premier onglet "grand livre comptable" et qu'à partir de là, en fonction de ce qu'il y a de marqué en colonne B "Section", la ligne entière se reporte automatiquement dans un onglet portant le même nom.
J'ai bien trouvé des sujets équivalents sur le forum mais impossible de m'en sortir avec les formules trop longues et je souhaite éviter si possible l'utilisation de VBA.
Je mets en PJ un extrait simplifié de mon tableau qui normalement comporte environ 1500 lignes et 14 onglets.
J'espère avoir été suffisamment claire. N'hésitez pas si besoin et surtout merci d'avance.

cordialement

Cliquez pour agrandir...

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim Plage
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .UsedRange
        If Sh.Name <> .Name Then
            Sh.Cells.Clear
            Plage.AutoFilter Field:=2, Criteria1:=Sh.Name
            Plage.SpecialCells(xlCellTypeVisible).Copy Sh.[a1]
        End If
        If .FilterMode Then .ShowAllData
    End With
End Sub

Jacky67 à dit:

Bonjour,
Une proposition en PJ, .......mais en VBA
Les feuilles se mettent à jour à leurs sélections.
Ce code dans le ThisWorkbook

VB:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim Plage
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .UsedRange
        If Sh.Name <> .Name Then
            Sh.Cells.Clear
            Plage.AutoFilter Field:=2, Criteria1:=Sh.Name
            Plage.SpecialCells(xlCellTypeVisible).Copy Sh.[a1]
        End If
        If .FilterMode Then .ShowAllData
    End With
End Sub

Cliquez pour agrandir...

78stl à dit:

J'ai une question supplémentaire: que devrais-je rajouter dans le code pour que je puisse mettre une somme automatique en bas de chaque onglet pour me faire la somme des charges, la somme des produits et le delta entre les deux?
merci d'avance

Estelle

Cliquez pour agrandir...

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim Plage, Lig&
    Application.ScreenUpdating = False
    With Feuil1
        If Sh.Name = .Name Then Exit Sub
        Set Plage = .UsedRange
        Sh.Cells.Clear
        Plage.AutoFilter Field:=2, Criteria1:=Sh.Name
        Plage.SpecialCells(xlCellTypeVisible).Copy Sh.[a1]
        If .FilterMode Then .ShowAllData
    End With
    With Sh
        Lig = .UsedRange.Rows.Count
        .Cells(Lig + 1, "f") = "Totaux:": .Cells(Lig + 2, "f") = "Delta:"
        .Range("f" & Lig + 1 & ":f" & Lig + 2).HorizontalAlignment = xlRight
        .Cells(Lig + 1, "g") = Application.Sum(.Range("g2:g" & Lig))
        .Cells(Lig + 1, "h") = Application.Sum(.Range("h2:h" & Lig))
        On Error Resume Next
        .Cells(Lig + 2, "g") = 0
        .Cells(Lig + 2, "g") = (.Cells(Lig + 1, "g") - .Cells(Lig + 1, "h")) / .Cells(Lig + 1, "g")
        .Cells(Lig + 2, "g").NumberFormat = "0.0%"
        .Range("g" & Lig + 1 & ":h" & Lig + 1).NumberFormat = "# ##0.00"
    End With
End Sub

Jacky67 à dit:

Bon, alors cette version.

VB:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim Plage, Lig&
    Application.ScreenUpdating = False
    With Feuil1
        If Sh.Name = .Name Then Exit Sub
        Set Plage = .UsedRange
        Sh.Cells.Clear
        Plage.AutoFilter Field:=2, Criteria1:=Sh.Name
        Plage.SpecialCells(xlCellTypeVisible).Copy Sh.[a1]
        If .FilterMode Then .ShowAllData
    End With
    With Sh
        Lig = .UsedRange.Rows.Count
        .Cells(Lig + 1, "f") = "Totaux:": .Cells(Lig + 2, "f") = "Delta:"
        .Range("f" & Lig + 1 & ":f" & Lig + 2).HorizontalAlignment = xlRight
        .Cells(Lig + 1, "g") = Application.Sum(.Range("g2:g" & Lig))
        .Cells(Lig + 1, "h") = Application.Sum(.Range("h2:h" & Lig))
        On Error Resume Next
        .Cells(Lig + 2, "g") = 0
        .Cells(Lig + 2, "g") = (.Cells(Lig + 1, "g") - .Cells(Lig + 1, "h")) / .Cells(Lig + 1, "g")
        .Cells(Lig + 2, "g").NumberFormat = "0.0%"
        .Range("g" & Lig + 1 & ":h" & Lig + 1).NumberFormat = "# ##0.00"
    End With
End Sub

Cliquez pour agrandir...

78stl à dit:

merci beaucoup! c'est top. j'ai même réussi à modifier le code pour que cela ne me marque pas un pourcentage dans le delta mais pour que cela me fasse une vraie soustraction.
Encore un grand merci
Estelle

Cliquez pour agrandir...

   '---------'
   With Sh
        Lig = .UsedRange.Rows.Count
        .Cells(Lig + 1, "f") = "Totaux:": .Cells(Lig + 2, "f") = "Delta:"
        .Range("f" & Lig + 1 & ":f" & Lig + 2).HorizontalAlignment = xlRight
        .Cells(Lig + 1, "g") = Application.Sum(.Range("g2:g" & Lig))
        .Cells(Lig + 1, "h") = Application.Sum(.Range("h2:h" & Lig))
        .Cells(Lig + 2, "g") = .Cells(Lig + 1, "g") - .Cells(Lig + 1, "h")
        .Range("g" & Lig + 1 & ":h" & Lig + 2).NumberFormat = "# ##0.00"
    End With
    '---------'