Duplice uso della verifica celle compilate

 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C2,F2,H2,F4,H4")) Is Nothing Then
        Call CreaNuovoOrdine
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Range("A1") <> 6 Then
        Range("A2") = "Mancano dati"
    Else
        Range("A2") = "eseguo macro"
        'TUA MACRO
    End If
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Range("C2,F2,H2,F4,H4,S2")) Is Nothing Then
        If Range("A1") <> 6 Then
            MessageBoxTimer
        Else
            'TUA MACRO
            MsgBox "Ho eseguito la macro"
        End If
    End If
    Application.EnableEvents = True
End Sub
Sub MessageBoxTimer()
    Dim AckTime As Integer, InfoBox As Object
    Set InfoBox = CreateObject("WScript.Shell")
    AckTime = 1
    Select Case InfoBox.Popup("Click OK (La finestra si chiude automaticamente).", _
    AckTime, , 0)
        Case 1, -1
            Exit Sub
    End Select
End Sub

If Range("S9") <> 5 Then
      Range("K9") = "Attesa inserimento dati"     
      Else         
      Range("K9") = ""         
' nuova aggiunta >>>>>>>>>>>>>>>>>>>>>>>>>>
            Dim rng1 As Boolean          
            If Not IsError(Range("A1").Value) Then         
            MsgBox "Valore nominale non corretto"         
           Exit Sub     
Else         
     Call CreaNuovoOrdine        
           End If 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<    
      End If     
Set rng = Nothing     
Application.EnableEvents = True 
End Sub

Sub CreaNuovoOrdine()     
Dim ws As Worksheet     
Dim ws1 As Worksheet     
NomeFoglio = [S2] 
If Range("C2") = "" Or Range("F2") = "" Or Range("H2") = "" Or Range("F4") = "" Or Range("H4") = "" Then     MsgBox ("i Campi obbligatori non sono tutti compilati "): Exit Sub 
End If  
Do While IsError(Range("D6")) 
valore = InputBox("Immetti valore corretto della lunghezza") Range("F4") = valore 
Loop     
Set wh = Worksheets(ActiveSheet.Name)     
Set ws1 = Worksheets("Master")     
For Each ws In Worksheets         
If ws.Name = NomeFoglio Then         
MsgBox "Il foglio " & NomeFoglio & " già esiste"         
Exit Sub         
End If     
Next     
ActiveSheet.Copy After:=Worksheets(Sheets.Count)         
If wh.Range("S2").Value <> "" Then         
ActiveSheet.Name = wh.Range("S2").Value         
End If          
ws1.Unprotect Password:="abc"         
ws1.Protect Password:="abc"                  
ws1.Visible = False         
ActiveSheet.Shapes.Range(Array("Button 1")).Delete
ActiveSheet.Rows("10:4040").EntireRow.Hidden = False
ActiveSheet.Protect Password:="abc"
ActiveSheet.Range("C12").Select
MsgBox ("Buon lavoro")  
End Sub