Sub Registra()
If Left(ActiveSheet.Name, 6) <> "scheda" Then Exit Sub
Dim Miascheda As String
Miascheda = ActiveSheet.Name
Dim MEMO()
Dim cl As Object
Dim X, Y As Integer
    
    If Cells(8, 3) = "" Then
    MsgBox ("Nr.Scheda inesistente")
    If Left(ActiveSheet.Name, 6) <> "scheda" Then Exit Sub
If Cells(19, 2) = "" Then
messaggio = MsgBox("SCHEDA VUOTA!!   Nessun articolo inserito", vbExclamation, "SCHEDA DI LAVORO")
Exit Sub
End If
    Range("C8").Select
    Range("C8").Formula = "=MAX(archivio!R2C1:R65536C1)+1"
    Exit Sub
    
    End If
    If MsgBox("REGISTRO LA SCHEDA ? ", vbYesNo) = 7 Then Exit Sub
    If Cells(19, 2) = "" Then
messaggio = MsgBox("SCHEDA VUOTA!!   Nessun articolo inserito", vbExclamation, "SCHEDA DI LAVORO")
Exit Sub
End If

    X = 0
    For Each cl In Range("c8,c9,f8,c55,d55,g49,g52")
    X = X + 1
    ReDim Preserve MEMO(X)
    MEMO(X) = cl
    Next cl
    Sheets("archivio").Select
    Cells(65536, 1).End(xlUp).Offset(1, 0).Select
    For Y = 1 To X
    Cells(ActiveCell.Row, Y) = MEMO(Y)
    Next Y
    Beep
    If MsgBox("Ho Registrato i Dati - Passo a " & Miascheda & "  ? ", vbYesNo) = 6 Then
    Sheets(Miascheda).Select
    End If
End Sub