Discussion :

[max55170]

En fait je me rends compte que je suis mal parti dès le début et c'est pour ça que je n'arrive pas à obtenir le résultat que je veux.
C'est pourquoi je voulais te demander s'il était possible de réécrire la macro en se basant sur l'exemple de mise en forme en pièce jointe.

Merci par avance.

Exemple_3.xlsx

[Daniel.C]

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
80
81
82
83
84
85
Sub test()
    Dim C As Range, X As Range, Feuille As String, Derligne As Integer
    Dim Ligne As Variant
    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
                    If Ligne = 7 Then Ligne = 8
                    .Cells(Ligne, 1).Resize(, 4).Value = C.Resize(, 4).Value
                    .[A:F].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 = Application.Match(C.Value, .[A:A], 0)
                    If Not IsNumeric(Ligne) Then
                        Ligne = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
                        .Cells(Ligne, 1).Resize(, 2).Value = C.Resize(, 2).Value
                    End If
                    .Cells(Ligne, 5).Resize(, 2).Value = C.Offset(, 2).Resize(, 2).Value
                    .[A:F].EntireColumn.AutoFit
                End With
            End If
        Next C
    End With
End Sub

[max55170]

Super merci beaucoup je suis enfin arrivé à mes fins.
Encore merci pour ta précieuse aide!