Discussion :

[AKARI-]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.test forum.xlsm

[Igloobel]

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

[AKARI-]

C'est corrigé

[EricDgn]

Bonjour,

Si je comprends bien, vous essayez d'avoir ce "bilan"

cela sans la ligne ABC45 vu que sa somme totale est 0 ?

Cordialement.

[AKARI-]

Bonjour EricDgn,

C'est exactement ça.

CDT.
AK

[EricDgn]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[AKARI-]

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

[EricDgn]

Bonjour,

Une façon de faire serait celle-ci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.