After a couple of minutes after posting I found the solution

Now I'm trying to copy the names of each sheet in rows 2...just above the
imported values...


Sub Tester2()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim sh As Worksheet
Dim FName As Variant, N As Long







SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings\Roby\Documenti\Nuova cartella (2)"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xls", _
MultiSelect:=True)

If IsArray(FName) Then
' Sort the Array
FName = Array_Sort(FName)

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
Colnum = 1

'Do While FName < ""
For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))
basebook.Worksheets(1).Cells(1, Colnum).Value = mybook.Name
For Each sh In mybook.Sheets(Array(("alfa", "beta", "gamma",
"delta"))
Set sourceRange = sh.Range("I3:J203")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets(1).Cells(3, Colnum)
sourceRange.Copy destrange

Colnum = Colnum + SourceCcount
Next sh
mybook.Close False
Next
End If

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub