Sub Macro1()
   Dim lung As Integer
   lung = Len(ActiveCell)
    With ActiveCell.Characters(Start:=lung, Length:=1).Font
        .Name = "Calibri"
        .FontStyle = "Normale"
        .Size = 8
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a1:a1000")) Is Nothing Then
Dim lung As Integer
If Target.Rows.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
On Error Resume Next
   lung = Len(Target)
   Application.EnableEvents = False
   Target.Value = "€ " & Target.Value
    With Target.Characters(Start:=lung + 2, Length:=1).Font
        .Name = "Calibri"
        .FontStyle = "Normale"
        .Size = 8
    End With
    Application.EnableEvents = True
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lung As Integer, nPos As Long
  If Not Intersect(Target, Range("a1:a1000")) Is Nothing Then
    With Target
      If .Cells.Count = 1 And .Value <> vbNullString Then
        Application.EnableEvents = False
        .Value = Format(.Value, "€ #,##0.00")
        Application.EnableEvents = True
        lung = Len(.Value)
        nPos = InStr(1, .Value, ",")
        If nPos > 0 Then
          .Characters(Start:=lung, Length:=1).Font.Size = 8
        Else
          .Font.Size = 11
        End If
      End If
    End With
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lung As Integer, nPos As Long
  If Not Intersect(Target, Range("a1:a1000")) Is Nothing Then
    With Target
      .NumberFormat = "@"
      If .Cells.Count = 1 And .Value <> vbNullString Then
        Application.EnableEvents = False
        .Value = Format(.Value, "€ #,##0.000")

        Application.EnableEvents = True
        lung = Len(.Value)
        nPos = InStr(1, .Value, ",")
        If nPos > 0 Then
          '.Characters(Start:=nPos, Length:=3).Font.Size = 8
          .Characters(Start:=lung, Length:=1).Font.Size = 8
        Else
          .Font.Size = 11
        End If
      End If
    End With
  End If
End Sub

     Range("A2:O2").Select
    Selection.Copy
    Range("UltimaA:O2").Select


              'qui si inserisce la Private Sub Worksheet_Change(ByVal Target As Range)
               '  una colta avviata si blocca a    
                                     '  If .Cells.Count = 1 And .Value <> vbNullString Then
 
    

        Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Sub EuroMillesimi()  'Come speravo potesse funzionare da Modulo 6
'GoTo Fine
  
  Dim target As Range, cella As Range, ws As Worksheet
  Dim lung As Integer, nPos As Long
  Set target = Selection.Cells
  Set ws = target.Parent
  
  ws.Unprotect
  If Not Intersect(target, ws.Range("i2:UltimaI")) Is Nothing Then
    For Each cella In target.Cells
      With cella
        .NumberFormat = "@"
        If .Cells.Count = 1 And .Value <> vbNullString Then
          Application.EnableEvents = False
          .Value = Format(.Value, "€ #,##0.000")
  
          Application.EnableEvents = True
          lung = Len(.Value)
          nPos = InStr(1, .Value, ",")
          If nPos > 0 Then
            '.Characters(Start:=nPos, Length:=3).Font.Size = 8
            .Characters(Start:=lung, Length:=1).Font.Size = 8
          Else
            .Font.Size = 11
          End If
        End If
      End With
    Next cella
  End If
  ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'Fine:
End Sub

Sub EuroMillesimi()  'Come speravo potesse funzionare da Modulo 6
'GoTo Fine
  
  Dim target As Range, cella As Range, ws As Worksheet
  Dim lung As Integer, nPos As Long
  Set target = Selection.Cells
  Set ws = target.Parent
  
  ws.Unprotect
  If Not Intersect(target, ws.Range("i2:UltimaI")) Is Nothing Then
    For Each cella In target.Cells
      With cella
        .NumberFormat = "@"
        If .Cells.Count = 1 And .Value <> vbNullString Then
          Application.EnableEvents = False
           '.Value = Format(.Value, "_-€*#.##0,000_-;-€*#.##0,000_-;_-€*" - "??_-;_-@_-")
          .Value = Format(.Value, "€ #,##0.000")
  
          Application.EnableEvents = True
          lung = Len(.Value)
          nPos = InStr(1, .Value, ",")
          If nPos > 0 Then
            '.Characters(Start:=nPos, Length:=3).Font.Size = 8
            .Characters(Start:=lung, Length:=1).Font.Size = 8
            .Characters(Start:=lung, Length:=1).Font.ColorIndex = 16
          Else
            .Font.Size = 11
          End If
        End If
      End With
    Next cella
  End If
End Sub

if target.value= sheets("foglio2").range("N2").value  then...

CUT 

Dim ultC As Long 
ultC = Sheets("Foglio1").Range("C" & Rows.Count).End(xlUp).Row 
For Each CL In Range("C1:C" & ultC) 

CUT