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
| Sub trihiver1()
'mot de passe
Dim Pass As String
Pass = InputBox("Mot de passe requis", "Imprimer le bon de commande", "Saisir le mot de passe ici")
If Pass <> "print" Then
Exit Sub
Else
Sheets("Bon de commande").Select
With ActiveSheet.PageSetup
.CenterHeader = "&""Arial,Gras""&10Commandes Hiver Semaine 1"
.RightHeader = "&""Arial,Gras""&10Date: " & Format(Date, "d mmm yyyy")
End With
Columns("A:AZ").Hidden = False
Range("A4:B4").FormulaR1C1 = "'HIVER - Semaine 1"
Rows("12:1900").Clear
Range("A12").Select
Dim F_S As Worksheet 'Feuille source
Dim F_D As Worksheet 'Feuille Destination
Dim Lig_S As Long 'Ligne source
Dim Lig_D As Long 'Ligne destination
'MEI **********************************************
'Définition des feuilles
Set F_S = Sheets("Commandes") 'feuille source = onglet(Rex)
Set F_D = Sheets("Bon de commande") 'feuille destination = onglet(perimee)
'définition des lignes
'Lig_D = F_D.Range("D1900").End(xlUp).Row + 1
'Ligne destination est la première de D vide
Lig_D = 12
'Programme *****************************************
For Lig_S = 12 To F_S.Range("D1900").End(xlUp).Row
'Pour Ligne source = dernière non vide en G jusqu'à la ligne 1
'en passant à la ligne précédente par décrémentation (-1)
'Quand la valeur est inférieure à 1, on passe à laligne suivant Next Lig_S
If IsNumeric(F_S.Range("D" & Lig_S)) Then
'évite les erreurs si tu as un titres
If Int(F_S.Range("D" & Lig_S)) > 0 Then
'D testé contient une date inférieure à aujourd'hui
F_S.Rows(Lig_S).Copy
F_D.Rows(Lig_D).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
F_D.Rows(Lig_D).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'on copie la ligne source sur la ligne destination
Lig_D = Lig_D + 1
'on passe à la ligne destination suivante
End If
End If
Next Lig_S
'Retour à l'instruction For Lig_S....
Columns("E:AU").Hidden = True
Columns("C:C").Hidden = True
MsgBox ("Fin de transfert")
'on avertit que c'est fini
Reponse = MsgBox("Voules-vous imprimer?", 36, "Demande d'impression")
If Reponse = 6 Then ActiveSheet.PrintOut Copies:=1
End If
End Sub |
Partager