Bjr,

J'ai une macro qui lance une Macro1 et 2 a la suite.

La Macro1 est la suivante :
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
 
Sub Macro1()
 
 Application.ScreenUpdating = False
 
    Dim nbLigne As Integer
    Dim MaCellule As Range
    Dim MaCellule_bis As Range
    Dim NumeroLigne As Integer
    Dim ok As Boolean
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
 
        Worksheets("Feuil1").Select
 
        Sheets("Feuil2").Select
        Columns("A:A").EntireColumn.AutoFit
        Columns("A:A").Select
        Selection.NumberFormat = "m/d/yyyy"
        Sheets("Feuil1").Select
        Columns("A:A").EntireColumn.AutoFit
        Columns("A:A").Select
        Selection.NumberFormat = "m/d/yyyy"
 
    For i = 2 To 20   'Feuil1 colonne 1
 
        For j = 2 To 50
 
            Worksheets("Feuil1").Select
 
            ValeuràChercher = Worksheets("Feuil" & j).Cells(i, 1).Value
 
            MemoNoLigneTrouvée = 0 ''initialise le N° de la ligne trouvée
 
            Range("A2:A3000").Find(What:=ValeuràChercher, After:=Range("A2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Select
 
            ActiveCell.Offset(0, 2).Select
 
            Selection.Copy
            Sheets("Feuil" & j).Select
            Range("E2").Select
            ActiveSheet.Paste
 
            Sheets("Feuil" & j).Select
 
            NumeroLigne = Range("A65000").End(xlUp).Row
 
            Sheets("Feuil" & j).Range("F2").Value = NumeroLigne
 
            Range("F3").Select
            ActiveCell.FormulaR1C1 = "=R[-1]C-1"
            Range("F3").Select
            Selection.Copy
            Range("F2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Range("F3").Select
            Application.CutCopyMode = False
            Selection.ClearContents
 
            If Range("E2").Value >= Range("F2").Value Then Exit Sub Else: Range("G2").Select
            ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
            Range("H2").Select
            ActiveCell.FormulaR1C1 = "=ABS(RC[-1])"
            Range("H2").Select
            Selection.Copy
            Range("G2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("H2").Select
            Application.CutCopyMode = False
            Selection.ClearContents
 
            nbLigne = Worksheets("Feuil" & j).Cells(2, 7).Value
 
            Set MaCellule = Range("A65000").End(xlUp)
            Set MaCellule_bis = Range("A65000").End(xlUp).Offset(1, 0)
            MaCellule_bis.Offset(-nbLigne, 0).Resize(nbLigne).EntireRow.Select
 
            Selection.Cut
 
            Sheets.Add
            ActiveSheet.Select
 
            Range("A2").Select
            ActiveSheet.Paste
            Range("A1").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = "Date"
            Range("B1").Select
            ActiveCell.FormulaR1C1 = "IMP/NIMP"
            Range("C1").Select
            ActiveCell.FormulaR1C1 = "Référence"
            Range("D1").Select
            Range("A1:C1").Select
            Selection.Font.Bold = True
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
 
            Sheets("Calendrier").Select
            Columns("B:B").Select
            Selection.NumberFormat = "m/d/yyyy"
 
            'Feuil1 colonne 1
 
            Worksheets("Calendrier").Select
 
            k = j + 1
 
            ValeuràChercher = Worksheets("Feuil" & k).Cells(i, 1).Value
 
            MemoNoLigneTrouvée = 0 ''initialise le N° de la ligne trouvée
 
            Range("B2:B3000").Find(What:=ValeuràChercher, After:=Range("B2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Select
 
            ActiveCell.Offset(1, 0).Select
 
            Sheets("Calendrier").Select
            Selection.Copy
            Sheets("Feuil" & k).Select
            Range("E2").Select
            ActiveSheet.Paste
            Columns("A:A").Select
            Application.CutCopyMode = False
            Selection.ClearContents
            Range("A1").Select
            ActiveCell.FormulaR1C1 = "Date"
            Range("E2").Select
            Selection.Copy
            Range("A2").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Application.CutCopyMode = False
            Selection.Copy
            Range("A3").Select
            ActiveSheet.Paste
            Range("A2", "A" & Range("B65536").End(xlUp).Row) = Range("A2")
 
            ActiveWindow.SmallScroll Down:=291
 
        Next j
    Next i
 
Application.ScreenUpdating = True
 
End Sub
La macro 2 est la suivante :
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
 
Sub Macro2()
 
 Dim fd As Worksheet ' Feuille destination
 Dim fs As Worksheet 'Feuille source (de la copie)
 
 Sheets.Add
 Set fd = ThisWorkbook.ActiveSheet 'On défini ici la feuille destination
 
 'Efface Feuille destination
 
  fd.Activate
 
 'Ecriture de l'entête sur Feuille destination
 
 fd.Cells(1, 1) = "Date"
 fd.Cells(1, 2) = "NIMP"
 fd.Cells(1, 3) = "Référence "
 
 For Each fs In ThisWorkbook.Worksheets
 
    If fs.Name <> fd.Name And fs.Name <> "Feuil1" And fs.Name <> "Calendrier" Then
    ' on va pas copier la feuille destination ...
    Debug.Print "Copie des données de " & fs.Name
    fs.Range(fs.Cells(2, 1), fs.Cells(1, 1).SpecialCells(xlLastCell)).Copy 'On copie à partir 1° ligne
    fd.Cells(fd.Cells(1, 1).CurrentRegion.Rows.Count + 1, 1).Select ' On se place sur cellule suivante le tableau récap
    fd.Paste ' on colle...
 
   End If
 
 Next
 
    Columns("A:A").Select
    Range("A1:C3000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
        ActiveSheet.Name = "Résumé"
 
        Columns("D:I").Select
        Selection.Delete Shift:=xlToLeft
 
End Sub
Je possède dans ma feuil1 un tableau avec 4 colonnes : Date/Qté IMP/Capacité Totale/Capacité Résiduelle.

La Feuil2 possède elle 3 colonnes : Date du jour/IMP.NIMP/Référence

Les 2 macros réalisent la chose suivante :

Elle recherche la date présente dans la feuille 2 dans la feuil1.
Elle sélectionne sa Capacité Résiduelle et elle le copie dans la Feuil 2.
Elle compte le nombre de ligne de la feuil 2.
On calcule la valeur Nombre de ligne-Capacité résiduelle.
On sélectionne le nombre de ligne correspondant à cette valeur à compter de la X lignes (X valeur Capacité résiduelle).
On fait un couper de ces lignes et on les place dans une nouvelle feuil.
On recherche alors dans la feuil "Calendrier" notre date et on copie la cellule qui la suit.
Cette valeur est alors coller dans la premiere colonne de notre nouvelle feuil.
On réalise à nouveau la meme action pour cette nouvelle date et pour toutes celles qui suivent jusqu'à ce que le nombre de ligne soit inférieur à la valeur de la capacité résiduelle.

Voila mon probleme est le suivant :
Parfois certaine personne oublie de saisir certaine date dans la Feuil1 avec leurs capacité résiduelle du cou le programme se retrouve dans une feuil ou la capacité résiduelle est inférieure au nombre de ligne mais il ne peut pas continuer la boucle car il manque la date du lendemain et sa capacité résiduelle.

Ce que je veux c'est qu'un message indiquant "Vous avez oublier de saisir la capacité pour certaines dates!!" apparaisse dans ce cas la.

En résume je veux quelque chose dans le genre : si qd je suis dans la derniere feuil j'ai ma valeur capacité résiduelle inférieur au nombre de ligne alors afficher le message.

J'espere avoir été clair.

Merci à tous.