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 |
Partager