Problème de macros

**max55170** · 13/05/2015, 10h33

Bonjour, voici mon problème :
dans un fichier j'ai une balance de comptes (compta) et je souhaite à partir de cette balance (sachant que je pourrais insérer d'autres balances après) reprendre certains comptes (donnés dans des plages de numéros de comptes) dont j'ai besoin et que je mettrai dans un nouvel onglet (un pour chaque catégorie).

Tout est sur le fichier en pièce jointe, macros ou formules ? Y a t-il une solution ?

J'espère que vous pourrez m'aider, merci par avance.

P.S : les comptes doivent tous être à 8 chiffres.
Exemple.xlsx

**Daniel.C** · 13/05/2015, 11h37

Bonjour,

Est-ce que tu peux donner un exemple de compte qui soit dans les plages définies en H3:J15 ?

**max55170** · 13/05/2015, 11h53

Par exemple le compte 27180000 - AUTRES TITRES IMMOBILISES se trouve dans la plage immos financières.

**Daniel.C** · 13/05/2015, 12h10

J'ai modifié le tableau en H3:J15. Le nouveau tableau est en H18:M30. Quand tu double cliques sur un compte de la feuille "Balance", si le compte se trouve dans une des plages, il est copié sur la feuille correspondante.

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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim C As Range, Feuille As String, Ligne As Long
    If Target.Column <> 1 Or Target.Value = "" Then Exit Sub
    Cancel = True
    For Each C In [H18:H30]
        If Target.Value >= C.Value And Target.Value <= C.Offset(, 1).Value Then
            Feuille = "Immos financieres"
            Exit For
        End If
    Next C
    If Feuille = "" Then
        For Each C In [J18:J26]
            If Target.Value >= C.Value And Target.Value <= C.Offset(, 1).Value Then
                Feuille = "Provisions"
                Exit For
            End If
        Next C
    End If
    If Feuille = "" Then
        For Each C In [L18:L26]
            If Target.Offset(, 1).Value >= C.Value And Target.Offset(, 1).Value <= C.Offset(, 1).Value Then
                Feuille = "Op. Exceptionnelles"
                Exit For
            End If
        Next C
    End If
    If Feuille <> "" Then
        With Sheets(Feuille)
            Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(Ligne, 1).Resize(, 3).Value = Target.Resize(, 3).Value
            .[A:D].EntireColumn.AutoFit
        End With
    End If
End Sub

PJ : max55170 Exemple.xlsm

**max55170** · 13/05/2015, 15h05

MERCI !! C'est vraiment génial, j'adore cette idée !

Bravo!

Re bonjour,
excuses moi de re déranger mais j'ai une dernière fois besoin de tes services.
J'aimerai si c'est possible que l'on puisse adapter la formule suivant l'exemple en pièce jointe.
J'ai maintenant une deuxieme balance.

Merci d'avance!
Exemple.xlsm

**Daniel.C** · 13/05/2015, 16h05

Teste : max55170 Exemple2.xlsm

**max55170** · 13/05/2015, 16h11

C'est parfait! C'est exactement ce que je cherchais.
Merci beaucoup!

Et une dernière, est il possible d'automatiser les doubles clics, c'est a dire qu'une seule touche ou une macro déclenche le double-clic de toutes les cellules ?

Merci d'avance! Normalement après ça j'aurai toutes les cartes en main.

**Daniel.C** · 13/05/2015, 16h38

Attache cette macro à un bouton. Si tu as un problème, dis-le.

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub test()
    Dim C As Range, X As Range, Feuille As String
    With Sheets("Balance N")
        For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
            Feuille = ""
            For Each X In .[H18:H30]
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                    Feuille = "Immos financieres"
                    Exit For
                End If
            Next X
            If Feuille = "" Then
                For Each X In .[J18:J26]
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Provisions"
                        Exit For
                    End If
                Next X
            End If
            If Feuille = "" Then
                For Each X In .[L18:L26]
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Op. Exceptionnelles"
                        Exit For
                    End If
                Next X
            End If
            If Feuille <> "" Then
                With Sheets(Feuille)
                    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(Ligne, 1).Resize(, 3).Value = C.Resize(, 3).Value
                    .[A:D].EntireColumn.AutoFit
                End With
            End If
        Next C
    End With
    Feuille = ""
    With Sheets("Balance N-1")
        For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
'            If C.Row = 27 Then Stop
            Feuille = ""
            For Each X In .[H18:H30]
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                    Feuille = "Immos financieres"
                    Exit For
                End If
            Next X
            If Feuille = "" Then
                For Each X In .[J18:J26]
                    If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Provisions"
                        Exit For
                    End If
                Next X
            End If
            If Feuille = "" Then
                For Each X In .[L18:L26]
                    If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Op. Exceptionnelles"
                        Exit For
                    End If
                Next X
            End If
            If Feuille <> "" Then
                With Sheets(Feuille)
                    Ligne = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
                    .Cells(Ligne, 6).Resize(, 3).Value = C.Resize(, 3).Value
                    .[F:H].EntireColumn.AutoFit
                End With
            End If
        Next C
    End With
End Sub

**max55170** · 18/05/2015, 15h17

ça marche !!

Je te remercierai jamais assez, je suis bluffé! Merci !!

Bonjour,
je me pose encore une question : comment modifier la formule afin d'y rajouter une plage de comptes ?
Par exemple dans le tableau en H18:M30, j'ai ajouter une ligne en H31 et J31.

Un grand merci d'avance.

**Daniel.C** · 18/05/2015, 17h27

Bonjour,

Je n'ai pas testé :

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub test()
    Dim C As Range, X As Range, Feuille As String, Derligne As Integer
    With Sheets("Balance N")
        For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
            Feuille = ""
            Derligne = .Cells(.Rows.Count, 8).End(xlUp).Row
            For Each X In .Range("H18:H" & Derligne)
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                    Feuille = "Immos financieres"
                    Exit For
                End If
            Next X
            If Feuille = "" Then
                Derligne = .Cells(.Rows.Count, 10).End(xlUp).Row
                For Each X In .Range("J18:J" & Derligne)
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Provisions"
                        Exit For
                    End If
                Next X
            End If
            If Feuille = "" Then
                Derligne = .Cells(.Rows.Count, 12).End(xlUp).Row
                For Each X In .Range("L18:L" & Derligne)
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Op. Exceptionnelles"
                        Exit For
                    End If
                Next X
            End If
            If Feuille <> "" Then
                With Sheets(Feuille)
                    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(Ligne, 1).Resize(, 3).Value = C.Resize(, 3).Value
                    .[A:D].EntireColumn.AutoFit
                End With
            End If
        Next C
    End With
    Feuille = ""
    With Sheets("Balance N-1")
        For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
'            If C.Row = 27 Then Stop
            Feuille = ""
            Derligne = .Cells(.Rows.Count, 8).End(xlUp).Row
            For Each X In .Range("H18:H" & Derligne)
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                    Feuille = "Immos financieres"
                    Exit For
                End If
            Next X
            If Feuille = "" Then
                Derligne = .Cells(.Rows.Count, 10).End(xlUp).Row
                For Each X In .Range("J18:J" & Derligne)
                    If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Provisions"
                        Exit For
                    End If
                Next X
            End If
            If Feuille = "" Then
                Derligne = .Cells(.Rows.Count, 12).End(xlUp).Row
                For Each X In .Range("L18:L" & Derligne)
                    If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Op. Exceptionnelles"
                        Exit For
                    End If
                Next X
            End If
            If Feuille <> "" Then
                With Sheets(Feuille)
                    Ligne = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
                    .Cells(Ligne, 6).Resize(, 3).Value = C.Resize(, 3).Value
                    .[F:H].EntireColumn.AutoFit
                End With
            End If
        Next C
    End With
End Sub

**max55170** · 19/05/2015, 08h59

Merci mais il y a un petit souci, dans les feuilles résultats (par exemple immos fin) toute la ligne de la balance n'est pas recopié.
Je devrai avoir dans cette feuille en N et N-1 : N° compte - Intitulé - Montant Debit - Montant Credit, or il me manque la dernière colonne qui n'est pas recopiée.

Voilà donc si tu as une solution je veux bien merci par avance.

**Daniel.C** · 19/05/2015, 10h09

Bonjour,

Effectivement :

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub test()
    Dim C As Range, X As Range, Feuille As String, Derligne As Integer
    With Sheets("Balance N")
        For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
            Feuille = ""
            Derligne = .Cells(.Rows.Count, 8).End(xlUp).Row
            For Each X In .Range("H18:H" & Derligne)
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                    Feuille = "Immos financieres"
                    Exit For
                End If
            Next X
            If Feuille = "" Then
                Derligne = .Cells(.Rows.Count, 10).End(xlUp).Row
                For Each X In .Range("J18:J" & Derligne)
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Provisions"
                        Exit For
                    End If
                Next X
            End If
            If Feuille = "" Then
                Derligne = .Cells(.Rows.Count, 12).End(xlUp).Row
                For Each X In .Range("L18:L" & Derligne)
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Op. Exceptionnelles"
                        Exit For
                    End If
                Next X
            End If
            If Feuille <> "" Then
                With Sheets(Feuille)
                    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(Ligne, 1).Resize(, 4).Value = C.Resize(, 4).Value
                    .[A:D].EntireColumn.AutoFit
                End With
            End If
        Next C
    End With
    Feuille = ""
    With Sheets("Balance N-1")
        For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
'            If C.Row = 27 Then Stop
            Feuille = ""
            Derligne = .Cells(.Rows.Count, 8).End(xlUp).Row
            For Each X In .Range("H18:H" & Derligne)
                If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                    Feuille = "Immos financieres"
                    Exit For
                End If
            Next X
            If Feuille = "" Then
                Derligne = .Cells(.Rows.Count, 10).End(xlUp).Row
                For Each X In .Range("J18:J" & Derligne)
                    If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Provisions"
                        Exit For
                    End If
                Next X
            End If
            If Feuille = "" Then
                Derligne = .Cells(.Rows.Count, 12).End(xlUp).Row
                For Each X In .Range("L18:L" & Derligne)
                    If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
                        Feuille = "Op. Exceptionnelles"
                        Exit For
                    End If
                Next X
            End If
            If Feuille <> "" Then
                With Sheets(Feuille)
                    Ligne = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
                    .Cells(Ligne, 6).Resize(, 4).Value = C.Resize(, 4).Value
                    .[F:H].EntireColumn.AutoFit
                End With
            End If
        Next C
    End With
End Sub

**max55170** · 20/05/2015, 11h49

Parfait ça marche !

Encore merci beaucoup!

j'ai une nouvelle question, un peu différente cette fois-ci.
Sais-tu s'il existe une macro ou une formule qui permette de supprimer toute une plage de cellules à partir d'une ligne spécifique.
Par exemple en pièce jointe : je souhaite que l'on ne voit plus aucune information à partir des mots "Immobilisations financières" en ligne 44 sachant que la page est générée de façon automatique.

Alors merci par avance.

test.xlsx

**Daniel.C** · 20/05/2015, 12h08

Bonjour,

Code :

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

1
2
3
4
    Dim Ligne As Long, DerLigne As Long
    Ligne = Cells.Find("Immobilisations financières :", , , xlWhole).Row
    DerLigne = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range(Ligne & ":" & DerLigne).EntireRow.Delete

**max55170** · 20/05/2015, 15h07

Merci bien elle marche mais je n'arrive pas à l'adapter à mon fichier original car la feuille en question n'existe pas tant qu'une macro n'a pas été lancée.
As-tu une solution en tête ?

Je te remercie.

**Daniel.C** · 20/05/2015, 15h10

Incorpore les lignes de code dans cette macro ?

**max55170** · 22/05/2015, 10h19

Merci j'ai trouvé la solution.

j'ai encore un petit problème : dans le fichier exemple en pièce jointe, je cherche à faire 2 sommes.
1 total bilan : Je veux faire la somme des soldes des numéros de comptes commençant par 2.
1 total CDR (compte de résultat) : Je veux faire la somme des soldes des numéros de comptes commençant par 6 et 7.

PS : Les numéros sont générées par macros donc une formule, si elle existe serait la bienvenue ou une macro.

Aurais-tu une solution ?

Je te remercie par avance.
Exemple.xlsx

**Daniel.C** · 22/05/2015, 12h26

Bonjour,

En C12 :

Code :

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

=SOMME.SI.ENS(C20:C25;A20:A25;">19999999";A20:A25;"<30000000")+SOMME.SI.ENS(E20:E25;A20:A25;">19999999";A20:A25;"<30000000")

en C15 :

Code :

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

=SOMME.SI.ENS(C20:C25;A20:A25;">59999999";A20:A25;"<80000000")+SOMME.SI.ENS(E20:E25;A20:A25;">59999999";A20:A25;"<80000000")

**max55170** · 22/05/2015, 15h14

Super merci ça marche!

Mais j'ai un autre probleme, je souhaite afficher l'écart d'un compte entre N et N-1 mais le souci (cf piece jointe) c'est que les comptes ne se trouvent pas toujours sur la même ligne.

Aurais-tu une idée ?

Merci!
Exemple_2.xlsx

**Daniel.C** · 22/05/2015, 15h30

En J20, à recopier vers le bas :

Code :

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

=SOMME.SI($A$20:$A$25;F20;$C$20:$C$25)-SOMME.SI($A$20:$A$25;F20;$D$20:$D$25)

Problème de macros [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager