'unifica tutte le tabelle dei singoli fogli in un unico foglio, il primo
Sub unifica()
Dim first_sheet As Worksheet, sh As Worksheet

    Set first_sheet = Foglio1
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> first_sheet.Name Then sh.[A1].CurrentRegion.Copy first_sheet.Cells([COUNTA(A:A)] + 1, 1)
    Next

End Sub

Sub separa()
Dim cella As Range, i As Integer, sep As Integer, v As Variant, k As Integer

    For Each cella In [A2:A760]
        i = i + 1
        
        Cells(cella.Row, 6) = "GEO" & Format(i, "0000")     'codice
        
        k = 7
        For Each v In Split(cella.Offset(, 1), vbLf)        'separa la domanda dalle risposte
            Cells(cella.Row, k) = Trim(v)
            k = k + 1
        Next

        Cells(cella.Row, 12) = Trim(cella.Offset(, 2))      'risposta esatta
    Next

    MsgBox "Ho terminato."
End Sub

Sub separa()
Dim cella As Range, i As Integer, sep As Integer, v As Variant, w As Variant, k As Integer, s As String

    For Each cella In [A2:A268]
        i = i + 1
        
        Cells(cella.Row, 6) = "ING" & Format(i, "0000")     'codice
        
        k = 7
        w = Split(cella.Offset(, 1), vbLf)
        If UBound(w) >= 4 Then
            For Each v In w        'separa la domanda dalle risposte
                If Trim(v) <> "" Then
                    Cells(cella.Row, k) = Replace(Trim(v), vbLf, "")
                    k = k + 1
                End If
            Next
        Else
            w = Split(cella.Offset(, 1), ")")
            Cells(cella.Row, 7) = Replace(Trim(Left(w(0), Len(w(0)) - 1)), vbLf, "")
            Cells(cella.Row, 8) = Replace("A) " & Trim(Left(w(1), Len(w(1)) - 1)), vbLf, "")
            Cells(cella.Row, 9) = Replace("B) " & Trim(Left(w(2), Len(w(2)) - 1)), vbLf, "")
            Cells(cella.Row, 10) = Replace("C) " & Trim(Left(w(3), Len(w(3)) - 1)), vbLf, "")
            Cells(cella.Row, 11) = Replace("D) " & Trim(Left(w(4), Len(w(4)) - 1)), vbLf, "")
        End If

        s = cella.Offset(, 2)
        s = Replace(s, vbLf, "")
        Cells(cella.Row, 12) = Trim(s)      'risposta esatta
    Next

    MsgBox "Ho terminato."
End Sub

Sub dividi() 
Dim x, y, L1, L2, L3, L4, r, col, n, n1, n2, n3, n4, dd, d1, d2, d3, d4, sh1 As Worksheet, sh2 As Worksheet 

Set sh1 = Worksheets("Table 1") 
Set sh2 = Worksheets("Foglio1") 

sh1.Activate 
r = 2 
col = 4 
For x = 8 To Cells(Rows.Count, 1).End(xlUp).Row 
    sh2.Cells(r, 1) = Cells(x, 1) 
    sh2.Cells(r, 3) = Cells(x, 4) 
    L1 = Len(Cells(x, 2)) 
    For y = 1 To L1 
        L4 = Mid(Cells(x, 2), y, 2) 
        Select Case L4 
            Case "A)" 
                dd = y 
            Case "B)" 
                d1 = y 
            Case "C)" 
                d2 = y 
            Case "D)" 
                d3 = y 
        End Select 
    Next y 
    n = d1 - dd 
    n1 = Trim(Mid(Cells(x, 2), dd, n)) 
    n = d2 - d1 
    n2 = Trim(Mid(Cells(x, 2), d1, n)) 
    If d3 > d2 Then n = d3 - d2 Else n = d2 - d3 
    n3 = Trim(Mid(Cells(x, 2), d2, n)) 
    n4 = Trim(Mid(Cells(x, 2), d3, L1)) 
    
    sh2.Cells(r, 2) = Trim(Mid(Cells(x, 2), 1, dd - 2)) 
    sh2.Cells(r, 4) = n1 
    sh2.Cells(r, 5) = n2 
    sh2.Cells(r, 6) = n3 
    sh2.Cells(r, 7) = n4 
    r = r + 1 
Next 
End Sub

Private Sub Workbook_Open()
    Sheets("Sfondo").Activate
    ActiveSheet.EnableSelection = xlNoSelection
    ActiveSheet.Protect Contents:=True, UserInterfaceOnly:=True
    'ActiveSheet Unprotect per sbloccare questo foglio!
End Sub