Option Explicit
Sub impression_enregistrement_remiseazéro()
Sheets("récap").Unprotect
Sheets("liste1").Unprotect
Sheets("liste2").Unprotect
Sheets("liste3").Unprotect
If MsgBox("voulez-vous valider la commande (copie dans récap)?", vbYesNo) = vbYes Then
Dim s As Worksheet
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each s In ThisWorkbook.Worksheets
If Not s.Name Like "récap" And Not s.Name Like "client" And Not s.Name Like "vins" Then
s.Range("A20:A71").SpecialCells(xlCellTypeConstants).EntireRow.Copy Sheets("récap").[A82].End(xlUp)(2)
End If
Next s
If MsgBox("Voulez-vous imprimer la commande(2 exemplaires)?", vbYesNo) = vbYes Then
Sheets("récap").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
End If
If MsgBox("Voulez vous enregistrer la commande?", vbYesNo) = vbYes Then
Sheets("récap").Select
Sheets("récap").Copy
ActiveSheet.Unprotect
Dim str As String
Dim dir As String
dir = "C:\Users\françois\Desktop\PG VIN\commande\"
Range("I1").Select
str = dir & ActiveCell.Text & ".xls"
ActiveWorkbook.SaveAs Filename:= _
str, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close
End If
If MsgBox("voulez vous effacer et en faire une nouvelles la commande?", vbYesNo) = vbYes Then
Sheets("liste2").Range("A21,a23,a25,a27,a29,a31,a33,a35,a37,a39,a41 ,a43,a45,a47,a49,a51,a53,a55,a57,a59,a61,a63,a65,a 67,a69,A71").ClearContents
Range("a21").Select
Sheets("liste3").Range("A21,a23,a25,a27,a29,a31,a33,a35,a37,a39,a41 ,a43,a45,a47,a49,a51,a53,a55,a57,a59,a61,a63,a65,a 67,a69,A71").ClearContents
Range("a21").Select
Sheets("liste1").Range("A21,a23,a25,a27,a29,a31,a33,a35,a37,a39,a41 ,a43,a45,a47,a49,a51,a53,a55,a57,a59,a61,a63,a65,a 67,a69,A71,F12:h14").ClearContents
Range("A21").Select
Range("a17").Value = Range("a17").Value + 1
Range("F5:H5").ClearContents
Range("F5:H5").Select
With Sheets("récap")
.Unprotect
Rows("19:81").Select
With Range("A75")
.ClearContents
.RowHeight = 15
ActiveSheet.Protect
End With
End With
End If
End If
Sheets("liste1").Protect
Sheets("liste2").Protect
Sheets("liste3").Protect
Sheets("liste1").Range("f5").Select
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub