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
| Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 18/04/2008 par AXC8300
'
'
Dim j As Double, k As Double
Sheets("Feuil2").Select
Range("A9").Select
ligne = Range("A9").Value
Cells(9, 2).Select
A = Cells(9, 2).Value
Cells(9, 3).Select
B = Cells(9, 3).Value
Range("A6").Select
zone = Range("A6").Value
Cells(6, 2).Select
feuille = Cells(6, 2).Value
Range("A13:T999").Select
Selection.ClearContents
Range("j6:T6").Select
Selection.ClearContents
Sheets("resume").Select
Cells(1, 1).Select
k = 13
l = 2
i = 1
If zone <> "" Then
While l > i
Cells.Find(What:=zone, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
l = ActiveCell.Row
Cells(l, 5).Select
If feuille = Cells(l, 5).Value Then
Rows(l).Select
Selection.Copy
Sheets("Feuil2").Select
Cells(k, 1).Select
ActiveSheet.Paste
k = k + 1
Sheets("resume").Select
i = i + 1
Cells(l + 1, 1).Select
If l < i Then
Sheets("Feuil2").Select
Rows(k - 1).Select
Rows(k - 1).Clear
End If
Else
i = i + 1
End If
Wend
Else
While l > i
Cells.Find(What:=ligne, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
l = ActiveCell.Row
Cells(l, 2).Select
If A = Cells(l, 2).Value Then
If B = Cells(l, 3).Value Then
Rows(l).Select
Selection.Copy
Sheets("Feuil2").Select
Cells(k, 1).Select
ActiveSheet.Paste
k = k + 1
Sheets("resume").Select
i = i + 1
Cells(l, 1).Select
End If
Else
i = i + 1
Cells(l, 1).Select
End If
Wend
End If
Sheets("Feuil2").Select
For i = 0 To 10
Cells(6, 10 + i).Select
ActiveCell.FormulaR1C1 = "=MAX(R[7]C:R[9999]C)"
Next
End Sub |
Partager