Microsoft 365 code erreur

[Tof072600]

Bonsoir,

Il est tard et je bloque sur un code erreur. Je suis novice en vba (j'ai commencé il y a deux jours).
Dans le fichier l'import de fichier est ok
la modification du fichier est ok
La remise du dossier ok
Mais lors de la confection du DA ( notamment mise en forme) j'ai une erreur. je pense simple mais je ne vois pas...
SI vous avez une idée je vous remercie

Très bonne soirée ou nuit

 

[Tof072600]

Re

Tu peux continuer la simplification de ton (toujours sur le même principe (pas de Select)
Range("D8").Select
ActiveCell.FormulaR1C1 = "=Sommaire!R[-3]C[-2]"
peut devenir
Range("D8").FormulaR1C1 = "=Sommaire!R[-3]C[-2]"
etc...

Sur ce, il est temps d'éteindre le PC.

Bonne nuit.

Merci oui c'était pour harmoniser les feuilles
merci pour ton aide!!
bonne nuit

 

[Staple1600]

Re

Je repasserai demain avec ma version "simplifiée" de la macro misenenforme.

Tu me diras si elle produit le même effet que l'original en situation réelle
(sur ton vrai fichier)

 

[Staple1600]

Bonjour @Tof072600 , le fil

Voici la première partie de ma proposition "Weight Watchers"

Sub miseenforme_B()
Dim Feuilles, vCrits, j%
Dim DernLigne As Long, i As Long, x As Long
Application.ScreenUpdating = False
' Filtres
Feuilles = Array("Capitaux", "Provisions", "Emprunt", "Immos_C", "Immos_F", "Stock", "Frs", "Clts", "Social", "Etat", "Autres", "Trésorerie", "Régul", "Exceptionnel")
vCrits = Array("_capit", "_prov", "_Emp", "_immoc", "_immof", "_Stock", "_Chges", "_Clt", "_Clt", "_Soc", "_Etat", "_Autres", "_Tréso", "_Régul", "_Excep")
For j = LBound(Feuilles) To UBound(Feuilles)
Range("Balance").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Fourchette").Range(vCrits(j)), CopyToRange:=Sheets(Feuilles(j)).Range("A8:D8"), Unique:=0
Sheets(Feuilles(j)).Columns("A:D").EntireColumn.AutoFit ' ajustement colonnes
Next
End Sub

(Je vais procéder étape par étape)
Peux-tu déjà me dire si cette première partie fait le job ?

PS: Testes sur une copie de ton classeur.

Question:
Avec ton filtre avancé, tu veux récupérer que la colonne A
(ou de A à D) comme le fait cette proposition ?

Merci d'éclairer ma lanterne

 

[Staple1600]

Re

@Tof072600
Voilà ma version simplifiée

Sub Nettoyage_avant_test()
Dim Feuilles, j%
Feuilles = Array("Capitaux", "Provisions", "Emprunt", "Immos_C", "Immos_F", "Stock", "Frs", "Clts", "Social", "Etat", "Autres", "Trésorerie", "Régul", "Exceptionnel")
For j = LBound(Feuilles) To UBound(Feuilles)
Sheets(Feuilles(j)).UsedRange.Clear
Cells.ClearOutline
Next
End Sub

Sub Mise_en_forme_D()
'Déclarations des variables
Dim Feuilles, vCrits, j%, DernLigne&, dl&, i&, x&
Application.ScreenUpdating = False 'figeage rafraichissement écran
' Tableaux
Feuilles = Array("Capitaux", "Provisions", "Emprunt", "Immos_C", "Immos_F", "Stock", "Frs", "Clts", "Social", "Etat", "Autres", "Trésorerie", "Régul", "Exceptionnel")
vCrits = Array("_capit", "_prov", "_Emp", "_immoc", "_immof", "_Stock", "_Chges", "_Clt", "_Clt", "_Soc", "_Etat", "_Autres", "_Tréso", "_Régul", "_Excep")
'traitements
For j = LBound(Feuilles) To UBound(Feuilles)
Range("Balance").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Fourchette").Range(vCrits(j)), CopyToRange:=Sheets(Feuilles(j)).Range("A8:D8")
With Sheets(Feuilles(j))
    .Columns("A:D").EntireColumn.AutoFit: .Columns(2).Insert Shift:=xlToRight: .Range("B8") = "a"
    DernLigne = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row
    .Range("B9:B" & DernLigne).Formula = "=LEFT(A9,2)"
    On Error Resume Next ' Si erreur, reprendre à l'instruction suivante
        If .Range("A9") <> 0 Then
        .Range("B8").Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4, 5), Replace:=-1, PageBreaks:=0, SummaryBelowData:=-1
        End If
    dl = .Cells(Rows.Count, 2).End(3).Row
    .Range("F8:G8") = Array("Variation", "%"): .Range("F9:F" & dl).Formula = "=+D9-E9"
    .Range("G9:G" & dl).Formula = "=IF(OR(E9=0,D9=0,D9="""",E9=""""),"""",D9/E9-1)"
    .Range("G9:G" & dl).Style = "Percent": .Range("D9:F" & dl).NumberFormat = "#,##0.00": .Outline.ShowLevels RowLevels:=2
    Set r = .[A8].CurrentRegion: r.SpecialCells(12).Interior.ColorIndex = 15: .Cells.ClearOutline
    r.Font.Name = "TrebuchetMs": r.Font.Size = 8: r.Borders.Value = 1: Set r = Nothing: .[A8:G8].Font.ColorIndex = 22
End With
Next
End Sub

La macro Nettoyage_avant_test est à lancer avant de de tester la macro Mise_en_forme_D
(Toujours à tester sur une copie)

NB: test OK sur ton fichier exemple (avec Excel 365)