dovrei modificare una macro di Anthony47
in quanto il file di testo ha 2/3 varianti invece di una
esempio
se la domanda è in colonna B1 e le 4 risposte sono in colonna B2 B3 B4 B5
la macro funziona e accorpa tutto in una sola cella B1
mentre se la domanda è in colonna B1 e le 4 risposte sono in B2 C2 B3 C3
la macro funziona in parte, accorpa solo la B2
la macro perfetta sarebbe quella che mettesse in ordine di righe le domande in B e le risposte in C D E F
http://www.filedropper.com/test_550
- Codice: Seleziona tutto
Sub Assemblad()
Dim OutSh As String, LastA As Long, I As Long, J As Long, CNum As Long
Dim K As Long, OI As Long, myB As String, myC As String, myD As String, myE As String, myF As String
OutSh = "Foglio2" '<<<<
Sheets(OutSh).Cells.ClearContents
LastA = Cells(Rows.Count, 1).End(xlUp).Row + 10
For I = 1 To LastA
CNum = Cells(I, 1)
For K = 1 To 10
If Cells(I + K, 1) <> "" Then Exit For
Next K
myB = "": myC = "": myD = "": myE = "": myF = ""
For J = 1 To K
myB = myB & " " & Cells(I + J - 1, 2)
myC = myC & " " & Cells(I + J - 1, 3)
myD = myD & " " & Cells(I + J - 1, 4)
myE = myE & " " & Cells(I + J - 1, 5)
myF = myF & " " & Cells(I + J - 1, 6)
Next J
OI = OI + 1
Sheets(OutSh).Cells(OI, 1) = CNum
Sheets(OutSh).Cells(OI, 2) = Trim(myB)
Sheets(OutSh).Cells(OI, 3) = Trim(myC)
Sheets(OutSh).Cells(OI, 4) = Trim(myD)
Sheets(OutSh).Cells(OI, 5) = Trim(myE)
Sheets(OutSh).Cells(OI, 6) = Trim(myF)
I = I + K - 1
Next I
End Sub