Hi all,

Can anybody please help.. i have the code below (many thanks to the
originator), but, i cannot get it to copy to an existing range in a
worksheet in my destination called 'status' i.e. something like Set
sh = Sheets("Status").Range("a2").. any help much appreciated.

Cheers

P

' SELECT THE FILES FROM THE FOLDER - HOLD CTRL



Sub GetData_Extract_Qs()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant, N As Long
Dim rnum As Long, DestRange As Range
Dim sh As Worksheet

SaveDriveDir = CurDir
MyPath = "C:\project info\Monthly Report\Final Versions"
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
'Add worksheet to the Activeworkbook and use the Date/Time as
name

Set sh = ActiveWorkbook.Worksheets.Add

sh.Name = Format("all") '<-- how do i change this????

'Loop through all files you select in the GetOpenFilename
dialog
For N = LBound(FName) To UBound(FName)

'Find the last row with data
rnum = LastRow(sh)

'create the destination cell address

Set DestRange = sh.Cells(rnum + 1, "A")

' For testing Copy the workbook name in Column E
sh.Cells(rnum + 1, "E").Value = FName(N)

'Get the cell values and copy it in the destrange
'Change the Sheet name and range as you like
GetData FName(N), "SECTION 6", "B14:J22", DestRange, False,
False

Next
End If

ChDrive SaveDriveDir
ChDir SaveDriveDir


Application.ScreenUpdating = True
End Sub