Ciao Mario 

Mi rivolgo a te  in particolare a te , e chi unque ci riesca  perchè ho trovato una macro in rete che penso sia tua 

Il problema è che mi serve con la condizione   for next   , ma fino a 4  for va benissimo , quando metto la 5°  non riesco  proprio a trovare  il modo di farla funzionare 

Allego il File e la macro 

Grazie a tutti

`MACRO ORIGINALE
--------------------------------
    Y = 4
    X = 3
    i = 3
    
    While Cells(i, 1) <> ""
        j = i + 1
            While Cells(j, 1) <> ""
                k = j + 1
                While Cells(k, 1) <> ""
                    l = k + 1
                    While Cells(l, 1) <> ""
                        m = l + 1
                        While Cells(m, 1) <> ""
                            Cells(X, Y) = (Cells(i, 1))
                            Y = Y + 1
                            Cells(X, Y) = (Cells(j, 1))
                            Y = Y + 1
                            Cells(X, Y) = (Cells(k, 1))
                            Y = Y + 1
                            Cells(X, Y) = (Cells(l, 1))
                            Y = Y + 1
                            Cells(X, Y) = (Cells(m, 1))
                            X = X + 1
                            m = m + 1
                            Y = 4
                        Wend
                        l = l + 1
                        Y = 4
                    Wend
                    k = k + 1
                    Y = 4
                Wend
                j = j + 1
                Y = 4
            Wend
            i = i + 1
            Y = 4
    Wend</code></pre><p> </p><pre class="language-c"><code>`Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

Var = WorksheetFunction.CountA(Foglio1.Range("D10:D29"))
    
  [j:n] = ""
    
Y = 10
    X = 2
  '  i = 10
    
 
        
     For i = 10 To 9 + Var
        j = i + 1
          For a = 11 To 9 + Var
             k = j + 1
                For b = 12 To 9 + Var
                    l = k + 1
                     For c = 13 To 9 + Var
                        m = l + 1
                        
                        
                        
                        While Cells(m, 4) <> ""
                            
                            
                    '      For d = 14 To 9 + Var
                            
                            
                            Cells(X, Y) = (Cells(i, 4))
                            Y = Y + 1
                            Cells(X, Y) = (Cells(j, 4))
                            Y = Y + 1
                            Cells(X, Y) = (Cells(k, 4))
                            Y = Y + 1
                            Cells(X, Y) = (Cells(l, 4))
                            Y = Y + 1
                            Cells(X, Y) = (Cells(m, 4))
                            X = X + 1
                            m = m + 1
                            Y = 10
                        
                        
                       ' Next
                        
                           Wend
                        
                        l = l + 1
                      Next
                   k = k + 1
                 Next
                j = j + 1
              Next
            Next

End Sub