Allora, la prima cosa che farei e' mettere tutto su un unico nuovo foglio. Per questo puoi usare il seguente codice:
- Codice: Seleziona tutto
Sub JoinSheets()
Sheets.Add before:=Sheets(1)
Columns("B:B").ColumnWidth = 45.11
Columns("C:F").ColumnWidth = 25
Columns("M:P").ColumnWidth = 25
For i = 2 To Worksheets.Count
Sheets(i).Range("A1").Resize(1000, 7).Copy Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next i
Application.CutCopyMode = False
Columns("A:A").UnMerge
Columns("A:A").WrapText = False
Columns("A:A").HorizontalAlignment = xlCenter
Columns("M:P").WrapText = True
Call MacroSort
lastR = Cells(Rows.Count, 1).End(xlUp).Row
Rows("1:" & lastR).EntireRow.AutoFit
Range("A1:P" & lastR).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select
End Sub
Sub MacroSort()
'
Columns("A:F").Select
ActiveWorkbook.Sheets(1).Sort.SortFields.Clear
ActiveWorkbook.Sheets(1).Sort.SortFields.Add2 Key:=Range( _
"A2:A3000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Sheets(1).Sort
.SetRange Range("A2:F3000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
Va messo tutto in un "Modulo standard" del progetto vba del tuo file; per istruzioni:
viewtopic.php?f=26&t=103893&p=647675#p647675Il codice contiene due macro: la Sub JoinSheets, che e' quella principale da mandare in esecuzione; la Sub MacroSort, che viene richiamata dalla macro principale e che si occupa di mettere in ordine crescente di colonna A il nuovo tabellone creato dall'unione dei fogli.
Per i suggerimenti su come eseguire una macro, vedi
viewtopic.php?f=26&t=103893&p=647678#p647678In fondo al tabellone troverai varie decine di righe spurie che vanno eliminate manualmente.
Ho separato la Sub MacroSort da quella principale perche' i comandi di ordinamento cambiano leggermente tra le versioni di Excel, e potrebbe darsi che il mio codice segnali un errore al momento dell'esecuzione; in questo caso devi registrare una tua macro mentre sul tuo pc esegui l'ordinamento e poi sostituisci (nella Sub JoinSheets) la riga
Call MacroSort con
Call TuaMacroRegistrataPer i suggerimenti su come registrare una macro, vedi
viewtopic.php?f=26&t=103893&p=622593#p622593Se procedi con una macro registrata allora pubblica comunque il codice ottenuto, perche' probabilmente conviene fare qualche piccola modifica per renderla piu' "solida"
Attenuto con questa procedura il tabellone possiamo procedere adattando quanto descritto nella discussione che aveva linkato Statix. In particolare:
In H2 metti la formula
- Codice: Seleziona tutto
=CASUALE()
Copia H2 e incolla in i2:k2
In M2 metti la formula
- Codice: Seleziona tutto
=SCARTO($B2;0;RANGO(H2;$H2:$K2))
Copia M2 e incolla in N2:P2
Ora copia H2:P2 e incolla verso il basso
Le colonne M:N riporteranno ora le risposte in modo casuale; puoi usare F9 per modificare la sequenza
Prima di stampare nascondi le colonne C:K, lasciando quindi solo le domande e le possibili risposte.
Quando stampi sara' utile impostare "Adatta tutte le colonne su una unica pagina" per impostare una scala idonea
Fai sapere...