I have this code, but I don't want always heading:
Sub Rapporto()
Dim Dati As Range, NumRec As Integer, Nr As Integer
Foglio2.UsedRange.ClearContents
With Foglio1.Range("IniDb").CurrentRegion
.Sort Range("IniDb").Cells(2, 1), Header:=xlGuess
NumRec = .Rows.Count - 1
Set Dati = Range("IniDB").Offset(1, 1).Resize(NumRec, .Columns.Count - 1)
End With
Dim i As Integer, j As Integer, k As Integer, _
IniRep As Range, Intestaz As Range, Nc As Integer
i = 1: j = 1: k = 2
Set IniRep = Range("IniRep")
With Range("IniDb")
Set Intestaz = Range(.Offset(0, 1), .End(xlToRight))
End With
Nc = Intestaz.Columns.Count
While i <= NumRec
Range("IniDb").Copy IniRep(j, 1)
IniRep(j + 1, 1) = Dati(i, 0)
Intestaz.Copy IniRep(j, 2)
Dati.Rows(i).Copy IniRep(j + 1, 2)
While Dati(i + 1, 0) = Dati(i, 0)
i = i + 1: k = k + Nc
Intestaz.Copy IniRep(j, k)
Dati.Rows(i).Copy IniRep(j + 1, k)
Wend
i = i + 1: j = j + 2: k = 2
Wend
Foglio2.Activate
End Sub