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
|
Sub Ref3x3()
Dim TheDate As Long, Index As Variant
Application.ScreenUpdating = False
Dim RngMyDateCde As Range
Dim DateCde As Date
Worksheets("chapiteaux").Activate
codeChap = "3x3" 'Code AGLM
DateCde = Range("A2")
DatRet = Range("B2")
temps = Range("C2")
'If Comment.TB3 = "" Then
'Else
Set codeChap = Range("A5:A100").Find(what:=codeChap)
If codeChap Is Nothing Then
MsgBox "Pas trouvé"
Else
'MsgBox CodeChap.Address '.Offset(1, 0).Cells(3, 1).Select
End If
'--------------------Recherche Date du début pour déduire le stock le temps de la cde---------------------------------------
Set RngMyDateCde = Range("C5:IV5").Find(what:=DateCde)
If RngMyDateCde Is Nothing Then
MsgBox "Pas trouvé"
Else
RngMyDateCde.Select
End If
'---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------
Set RngMyDateCde = ActiveCell
col = RngMyDateCde.Column
Set Chap = Range("A7:A100").Find(codeChap)
Ligne = Chap.Row
Cells(Ligne, col).Select
'Rempli le calendrier des sorties
'Stop
For i = 1 To 5
'Stop
For j = 1 To temps
'MsgBox j
If ActiveCell = "" Then
ActiveCell.Offset(0, 1).Select
Else
If j = 1 Then
Do While Not (IsEmpty(ActiveCell)) 'Boucle jusqu'a la prochaine cellule vide
Selection.Offset(1, 0).Select
Loop
Else
ActiveCell.Offset(0, (-j + 1)).Select
ActiveCell.Offset(1, 0).Select
Do While Not (IsEmpty(ActiveCell)) 'Boucle jusqu'a la prochaine cellule vide
Selection.Offset(1, 0).Select
Loop
End If
End If
Next j
'Stop
ActiveCell.Offset(0, (-j + 1)).Select
'If (j - 1) = temps Then
For k = 1 To 4
ActiveCell = "S"
ActiveCell.Offset(0, 1).Select
Next k
ActiveCell.Offset(0, (-k + 1)).Select
ActiveCell.Offset(1, 0).Select
Next i
End Sub |
Partager