Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import data from multiple excel files in one folder
I have a set of sequentially numbered files (starting at 1000.xls) in a main
folder that contains subfolders. I want to import data from certain fields, with a new row for each file. I currently am using: ='P:\Folder 1\Main Folder\subfolder\[1002.xls]POForm1'!$L$1 to link to the data I want, modifying the file number by hand to update the file. I have 32 different pieces of data that I am pulling from each file, along with 6200 files and counting..... |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import data from multiple excel files in one folder
hi WingZero
Try this example http://www.rondebruin.nl/summary2.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "WingZero" wrote in message ... I have a set of sequentially numbered files (starting at 1000.xls) in a main folder that contains subfolders. I want to import data from certain fields, with a new row for each file. I currently am using: ='P:\Folder 1\Main Folder\subfolder\[1002.xls]POForm1'!$L$1 to link to the data I want, modifying the file number by hand to update the file. I have 32 different pieces of data that I am pulling from each file, along with 6200 files and counting..... |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import data from multiple excel files in one folder
Ron, thanks for the help, but I apparently need a bit more. =(
I just tried example one, and it will do what I need other than the small detail of all the lines show as yellow, and none of the data that I need comes in. Below is the modded script, including which cells I need. Sub Summary_cells_from_Different_Workbooks_1() Dim FileNameXls As Variant Dim SummWks As Worksheet Dim ColNum As Integer Dim myCell As Range, Rng As Range Dim RwNum As Long, FNum As Long, FinalSlash As Long Dim ShName As String, PathStr As String Dim SheetCheck As String, JustFileName As String Dim JustFolder As String ShName = "Sheet3" '<---- Change Set Rng = Range("L1,D5,D7,D8,D9,F9,D10,J9,L9,L10,D40,B20,F19 :F38") '<---- Change 'Select the files with GetOpenFilename FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _ MultiSelect:=True) If IsArray(FileNameXls) = False Then 'do nothing Else With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With 'Add a new workbook with one sheet for the Summary Set SummWks = Workbooks.Add(1).Worksheets(1) 'The links to the first workbook will start in row 2 RwNum = 1 For FNum = LBound(FileNameXls) To UBound(FileNameXls) ColNum = 1 RwNum = RwNum + 1 FinalSlash = InStrRev(FileNameXls(FNum), "\") JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1) JustFolder = Left(FileNameXls(FNum), FinalSlash - 1) 'copy the workbook name in column A SummWks.Cells(RwNum, 1).Value = JustFileName 'build the formula string JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''") PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!" On Error Resume Next SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1)) If Err.Number < 0 Then 'If the sheet not exist in the workbook the row color will be Yellow. SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _ .Interior.Color = vbYellow Else For Each myCell In Rng.Cells ColNum = ColNum + 1 SummWks.Cells(RwNum, ColNum).Formula = _ "=" & PathStr & myCell.Address Next myCell End If On Error GoTo 0 Next FNum ' Use AutoFit to set the column width in the new workbook SummWks.UsedRange.Columns.AutoFit MsgBox "The Summary is ready, save the file if you want to keep it" With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End If End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import data from multiple excel files in one folder
No problem here
Are you sure that every workbook have a sheet named "Sheet3" ? -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "WingZero" wrote in message ... Ron, thanks for the help, but I apparently need a bit more. =( I just tried example one, and it will do what I need other than the small detail of all the lines show as yellow, and none of the data that I need comes in. Below is the modded script, including which cells I need. Sub Summary_cells_from_Different_Workbooks_1() Dim FileNameXls As Variant Dim SummWks As Worksheet Dim ColNum As Integer Dim myCell As Range, Rng As Range Dim RwNum As Long, FNum As Long, FinalSlash As Long Dim ShName As String, PathStr As String Dim SheetCheck As String, JustFileName As String Dim JustFolder As String ShName = "Sheet3" '<---- Change Set Rng = Range("L1,D5,D7,D8,D9,F9,D10,J9,L9,L10,D40,B20,F19 :F38") '<---- Change 'Select the files with GetOpenFilename FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _ MultiSelect:=True) If IsArray(FileNameXls) = False Then 'do nothing Else With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With 'Add a new workbook with one sheet for the Summary Set SummWks = Workbooks.Add(1).Worksheets(1) 'The links to the first workbook will start in row 2 RwNum = 1 For FNum = LBound(FileNameXls) To UBound(FileNameXls) ColNum = 1 RwNum = RwNum + 1 FinalSlash = InStrRev(FileNameXls(FNum), "\") JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1) JustFolder = Left(FileNameXls(FNum), FinalSlash - 1) 'copy the workbook name in column A SummWks.Cells(RwNum, 1).Value = JustFileName 'build the formula string JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''") PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!" On Error Resume Next SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1)) If Err.Number < 0 Then 'If the sheet not exist in the workbook the row color will be Yellow. SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _ .Interior.Color = vbYellow Else For Each myCell In Rng.Cells ColNum = ColNum + 1 SummWks.Cells(RwNum, ColNum).Formula = _ "=" & PathStr & myCell.Address Next myCell End If On Error GoTo 0 Next FNum ' Use AutoFit to set the column width in the new workbook SummWks.UsedRange.Columns.AutoFit MsgBox "The Summary is ready, save the file if you want to keep it" With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End If End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import data from multiple excel files in one folder
That was the issue. I don't know what I was thinking when I first read the
code, but I had "Sheet3" in my mind as being a sheet that was going to be created when the code ran. This is what happens when you have to get up early for work and you're not a morning person. =) |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import data from multiple excel files in one folder
Hi WingZero
Glad you got it working This is above the code Change these two lines before you run the macro with the sheet name and range in each workbook that you select with GetOpenFilename Note: If the sheet not exists in the workbook the row will be yellow. ShName = "Sheet1" '<---- Change Set Rng = Range("A1,D5:E5,Z10") '<---- Change Looks OK for me but English is not my language so maybe it is not clear ? -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "WingZero" wrote in message ... That was the issue. I don't know what I was thinking when I first read the code, but I had "Sheet3" in my mind as being a sheet that was going to be created when the code ran. This is what happens when you have to get up early for work and you're not a morning person. =) |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import data from multiple excel files in one folder
No, it is fairly clear, I just had my mind somwhere else I suppose.
A slightly better wording however, would be: Change the following two lines of code before you run the macro. Each workbook that is selected with GetOpenFilename should contain a sheet name and data range that matches your changes. Note: If the sheet does not exist in a selected workbook, that row will be highlighted in yellow. ShName = "Sheet 1" '<----------Change sheet name Set Rng = Range("A1,D5:E5,Z10") '<----------Change selected cells Thanks again for the help. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Import data from multiple excel files in one folder
Thanks
I will update the text -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "WingZero" wrote in message ... No, it is fairly clear, I just had my mind somwhere else I suppose. A slightly better wording however, would be: Change the following two lines of code before you run the macro. Each workbook that is selected with GetOpenFilename should contain a sheet name and data range that matches your changes. Note: If the sheet does not exist in a selected workbook, that row will be highlighted in yellow. ShName = "Sheet 1" '<----------Change sheet name Set Rng = Range("A1,D5:E5,Z10") '<----------Change selected cells Thanks again for the help. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Open many *.tsv files in folder and import the data into Excel | Excel Programming | |||
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 | |||
Import data from multiple excel files | Excel Programming | |||
Excel VBA - Import Data for manipulation from multiple text files | Excel Programming |