for wsN = 1 to 16

Sub Скругленныйпрямоугольник1_Щелчок()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String

'Отключение отоброжения выполняемых действий
Application.ScreenUpdating = False


'Create folder => act of defective parts
MkDir "G:\"

'Save in sheet in pdf format
ThisWorkbook.Sheets(Array("1")).Select
  

Select Case Range("V7").Value

Case Is < 0.75: Call Scoreless
Case Is >= 0.75: Call Scoremore

End Select

ThisWorkbook.Sheets(Array("2")).Select
  
Select Case Range("V7").Value

Case Is < 0.75: Call Scoreless
Case Is >= 0.75: Call Scoremore

End Select

ThisWorkbook.Sheets(Array("3")).Select
  
Select Case Range("V7").Value

Case Is < 0.75: Call Scoreless
Case Is >= 0.75: Call Scoremore

End Select

ThisWorkbook.Sheets(Array("4")).Select
  
Select Case Range("V7").Value

Case Is < 0.75: Call Scoreless
Case Is >= 0.75: Call Scoremore

End Select

'Open folder
Sheets("1").Select
Shell "explorer.exe " & "G:" & "\", vbMaximizedFocus


End Sub
----------------------------------------------------------
Sub Scoremore()

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="G:" & _
ActiveSheet.Range("D4").Value & Range("X3") & "2019.pdf", _
OpenAfterPublish:=False

Dim objOL As Object
Set objOL = CreateObject("Outlook.Application")
Set objMail = objOL.CreateItem(0)
With objMail
.To = Range("E51").Value
.CC = Range("E52").Value
.Body =
.Display
End With
Set objMail = Nothing
Set objOL = Nothing

End Sub
-----------------------------------------------------------
Sub Scoreless()

'return for normal print area
ActiveSheet.PageSetup.PrintArea = "$B$2:$AA$48"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="G:" & _
ActiveSheet.Range("D4").Value & " - " & Range("X3") & " 2019.pdf", _
OpenAfterPublish:=False

'Save detail information about score card for supplier
ActiveSheet.PageSetup.PrintArea = "$AE$2:$AX$58"
'ActiveSheet.VPageBreaks.DragOff Direction:=xlToRight, RegionIndex:=1

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="G:\" & _
ActiveSheet.Range("D4").Value & Range("X3") & "2019 - detail information.pdf", _
OpenAfterPublish:=False

'return for normal print area
ActiveSheet.PageSetup.PrintArea = "$B$2:$AA$48"


Dim objOL As Object
Set objOL = CreateObject("Outlook.Application")
Set objMail = objOL.CreateItem(0)
With objMail
.To = Range("E51").Value
.CC = Range("E52").Value
.Body = 
.Subject = 
.Display
End With
Set objMail = Nothing
Set objOL = Nothing

End Sub

'Send email
Sheets("Protocol").Select
Select Case Range("JA12").Value
Case Is = "Russian-Warehouse"
Call Russian_warehouse
Case Is = "Russian-Incoming inspection"
Call Russian_incoming_inspection
Case Is = "Russian-Machining operation"
Call Russian_machining
Case Is = "Russian-Assembly process"
Call Russian_assembly_operation
Case Is = "Russian-Warranty period"
Call Russian_warranty
Case Is = "English-Warehouse"
Call English_warehouse
Case Is = "English-Incoming inspection"
Call English_incoming_inspection
Case Is = "English-Machining operation"
Call English_maching
Case Is = "English-Assembly process"
Call English_assembly
Case Is = "English-Warranty period"
Call English_warranty
End Select

x = Range("IZ11")
y = Range("JA11")
Select Case x And y
Case Is = (x = "Russian") And (y = "Warehouse")
Call Russian_warehouse
Case Is = (x = "Russian") And (y = "Incoming inspection")
Call Russian_incoming_inspection
Case Is = (x = "Russian") And (y = "Machining operation")
Call Russian_machining
Case Is = (x = "Russian") And (y = "Assembly process")
Call Russian_assembly_operation
Case Is = (x = "Russian") And (y = "Warranty period")
Call Russian_warranty
Case Is = (x = "English") And (y = "Warehouse")
Call English_warehouse
Case Is = (x = "English") And (y = "Incoming inspection")
Call English_incoming_inspection
Case Is = (x = "English") And (y = "Machining operation")
Call English_maching
Case Is = (x = "English") And (y = "Assembly process")
Call English_assembly
Case Is = (x = "English") And (y = "Warranty period")
Call English_warranty
End Select