Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy specific range from files in folder = enhancements needed
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy specific range from files in folder = enhancements needed
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Pulling pdf files from general folder to specific folder | Excel Discussion (Misc queries) | |||
how can I specific a folder with wildcard criteria and excel will import all the correct files in that folder? | Excel Discussion (Misc queries) | |||
how can I specific a folder with wildcard criteria and excel will import all the correct files in that folder? | Excel Programming | |||
Macro to copy range from Excel files in folder | Excel Discussion (Misc queries) | |||
Copy several range from all files in folder into several worksheets | Excel Programming |