Amélioration MACRO VBA

Bonjour à tous/toutes,

Contexte:
Dans le cadre de mon tableau de bord j'ai une difficulté sur une partie de ma macro
Je récupère les infos d'une requête (onglet DATA) que je mets dans mon tableau de suivi (onglet Bilan)
J'ai simplifié mon fichier joint, vous pouvez voir :
• en ORANGE (Réf, Date, Montants >0) = les éléments à faire apparaitre sur l'onglet Bilan.
• en rouge les éléments qui me servent à avoir les conditions.

Code : actuel

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36

Sub forum() ' ' forum Macro ' Dim Ligne, Colonne, boucle, Ligne_courante As Integer Dim CA As String Dim BILAN, DATA As Worksheet Set BILAN = Application.ActiveWorkbook.Worksheets("Bilan") Set DATA = Application.ActiveWorkbook.Worksheets("DATA") Ligne_courante = Range("B" & Rows.Count).End(xlUp).Row + 1   'Balayage de Data For Ligne = 2 To DATA.UsedRange.Rows.Count   'Deux Conditions pour executer la macro:LE TOTAL RAJOUTE (Col AD est different de 0 et Il faut que "TOTAL" soit ecrit en B) If (DATA.Cells(Ligne, 30)) <> 0 And (DATA.Cells(Ligne, 2)) = "TOTAL" Then   For Colonne = 4 To DATA.UsedRange.Columns.Count boucle = 1 'Typage des mois If boucle = 1 Then 'DATE BILAN.Cells(Ligne_courante, 1) = DATA.Cells(1, Colonne) 'CA BILAN.Cells(Ligne_courante, 2) = DATA.Cells(Ligne, 1) 'Montants BILAN.Cells(Ligne_courante, 3) = DATA.Cells(Ligne, Colonne)   Ligne_courante = Ligne_courante + 1   End If Next Colonne End If Next Ligne   End Sub

---

Problème :
Mon petit code fonctionne mais n'est pas optimum vu que je dois encore faire des retraitements à la mano et donc j'aimerais l'améliorer pour :

• Ne pas faire apparaitre le TOTAL mais que la Date
• Ne pas avoir à rajouter une colonne TOTAL (Somme de la ligne) et faire en sorte que la macro prenne la Réf si le montant est >0 avec la date qui corresponds.

Merci par avance pour votre aide,

Bien à vous.
AK.Pièce jointe 520421

Bionjour,

Tu n'as pas lu les règles du Forum

avant de balancé ton fichier sort ton code utilise les balises Code (#)

et mets (s'il n'y a pas de données confidentielles) des captures écrans

C'est corrigé

Bonjour,

Si je comprends bien, vous essayez d'avoir ce "bilan"
Pièce jointe 521549
cela sans la ligne ABC45 vu que sa somme totale est 0 ?

Cordialement.

Bonjour EricDgn,

C'est exactement ça.

CDT.
AK

Bonjour,

Pour cela le plus simple est sans doute d'utiliser les "affichages personnalisés" (onglet "Affichage", groupe "Affichages classeur", bouton "Personnaisé"), et si vraiment nécessaire poser 2 boutons pour passer de l'un à l'autre avec ces macros:

Code:

---

1 2 3 4 5 6 7

Sub Data_Normal() ActiveWorkbook.CustomViews("DataNormal").Show End Sub   Sub Data_Bilan() ActiveWorkbook.CustomViews("DataSynthèse").Show End Sub

---

Bonne continuation.

Merci beaucoup pour ta réponse, la macro pour l'affichage personnalisé me servira à coup sur !
Mais dans ce cas il me faut vraiment extraire les données, car j'extrait plusieurs sources de données.

Je suis en train d'essayer un Select Case avec la répétition de chaque période mais je pense qu'il y à une méthode plus concrète.

CDT.
AK

Bonjour,

Une façon de faire serait celle-ci:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Sub CopieData() '--- ajoute les lignes utiles de la feuille courante dans la feuille Bilan Dim kR As Long, kRlast As Long, kRb As Long Dim wsBilan As Worksheet Set wsBilan = Application.ActiveWorkbook.Worksheets("Bilan") If ActiveSheet.Name = wsBilan.Name Then MsgBox "Annulé: placez vous sur une feuille dont les données utiles" & vbLf & _ "sont à ajouter à la feuille Bilan.", , " Anomalie" Exit Sub End If kRb = wsBilan.Range("B" & Rows.Count).End(xlUp).Row '--- dernière ligne Bilan For kR = 2 To ActiveSheet.UsedRange.Rows.Count '--- balayage lignes feuille courante If Cells(kR, 1) <> "" Then '--- cellule non vide en colonne 1 If Cells(kR, 2) = "TOTAL" Then '--- "Total" en colonne 2 If WorksheetFunction.Sum(Range(Cells(kR, 3), Cells(kR, 29))) > 0 Then '--- cumul > 0 kRb = kRb + 1 '--- ligne suivante dans Bilan Range(Cells(kR, 1), Cells(kR, 30)).Copy wsBilan.Cells(kRb, 1) '--- copie colonne 1 à 30 dans Bilan End If End If End If Next kR End Sub

---

et ensuite utiliser un affichage personnalisé pour n'avoir que les colonnes utiles dans la feuille Bilan.

Bonne continuation.