Though I do not know VBA I managed to adapt Ron de Bruins code as follows. It
does what I want thus far. I now wish to have an additional condition i.e.IF
Consol!D2=1 Application.Run €œCopyToSh5€� , IF Consol!D2=2, Application.Run
€œCopyToSh6€�,IF Consol!D2=3,Application.Run €œCopyToSh7€�, etc upto 10. Any help
from the ng will be appreciated.. Also would it be possible to select the
files from a list (named range €œSALES€�) in the Main Sheet rather than an
onscreen selection

Sub GetData_Example3()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant, N As Long
Dim destrange As Range
Dim sh As Worksheet
Application.Run "DeleteConsol"
SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'or use "C:\Data"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xls", _
MultiSelect:=True)
If IsArray(FName) Then
FName = Array_Sort(FName)

Application.ScreenUpdating = False
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = "Consol"
For N = LBound(FName) To UBound(FName)

Set destrange = sh.Cells(1, 1)
GetData FName(N), "Sheet1", "A1:D6", destrange, True
Application.Run "CopyToSh5"
Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
=============================
Sub CopyToSh5()
'
' Macro recorded 11/12/2005 by Robert
Sheets("Consol").Select
Range("A1:D6").Select
Selection.Copy
Sheets("Sheet5").Select

Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd,
SkipBlanks _
:=False, Transpose:=False
End Sub
================================================== =
Sub DeleteConsol()
' Macro recorded 11/12/2005 by Robert
Sheets("Consol").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet5").Select
Selection.Clear
End Sub

--
Robert