H
harteorama
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
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