Dear All,

I've found a very useful macro on Ron de Bruin's page (see below)
("Copy a range from all files that you have selected with GetOpenFilename")

Now, i would like to slightly change the last part of it:
1) instead of having the whole path copied as a name, I would prefer to have
only the workbook name
2) instead of predefined sheet name (in example: "Sheet1"), I would like to
be able to extract the range from the "active sheet"

' 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), "Sheet1", "A1:C1", destrange, False, False
Is it feasible?
Thanks for your help!
Mark


Here's the whole original code:

Sub GetData_Example5()
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 = Application.DefaultFilePath 'or use "C:\Data"
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(Now, "dd-mm-yy h-mm-ss") '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), "Sheet1", "A1:C1", destrange, False, False
Next End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

1) To get the filename from the full pathname use this code

MyPath = ""
Do While InStr(MyFilename, "\") > 0
MyPath = MyPath & Left(MyFilename, InStr(MyFilename, "\"))
MyFilename = Mid(MyFilename, InStr(MyFilename, "\") + 1)
Loop
'remove extension from filename
RootFileName = Left(MyFilename, InStr(MyFilename, ".") - 1)


"markx" wrote:

> Dear All,
>
> I've found a very useful macro on Ron de Bruin's page (see below)
> ("Copy a range from all files that you have selected with GetOpenFilename")
>
> Now, i would like to slightly change the last part of it:
> 1) instead of having the whole path copied as a name, I would prefer to have
> only the workbook name
> 2) instead of predefined sheet name (in example: "Sheet1"), I would like to
> be able to extract the range from the "active sheet"
>
> ' 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), "Sheet1", "A1:C1", destrange, False, False
> Is it feasible?
> Thanks for your help!
> Mark
>
>
> Here's the whole original code:
>
> Sub GetData_Example5()
> 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 = Application.DefaultFilePath 'or use "C:\Data"
> 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(Now, "dd-mm-yy h-mm-ss") '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), "Sheet1", "A1:C1", destrange, False, False
> Next End If
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>
>
>