Hi,
I have built a VBA macro to combine multiple Excel files into one sheet, format the contents and then do some calculations.
However, it would be really useful to have the original file name against each row in the combined sheet. For example, I could see that rows 1-20 came from Sheet A, 21-40 Sheet B and 41-60 Sheet C etc.
Here is the code that I used to combine the worksheets. Does anybody know how I could modify this to add the original workbook name into Column A of the combined sheet?
Any help is very much appreciated.
I have built a VBA macro to combine multiple Excel files into one sheet, format the contents and then do some calculations.
However, it would be really useful to have the original file name against each row in the combined sheet. For example, I could see that rows 1-20 came from Sheet A, 21-40 Sheet B and 41-60 Sheet C etc.
Here is the code that I used to combine the worksheets. Does anybody know how I could modify this to add the original workbook name into Column A of the combined sheet?
Code:
Sub ReportRunner()
Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
LastDataRow As Long, LastDataCol As Long, _
HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range
'initialize constants
MaxNumberFiles = 2001
HeaderRow = 6 'assume headers are always in row 1
LastOutRow = 1
'prompt user to select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
.AllowMultiSelect = True
.Title = "Select Boards to Combine:"
.ButtonName = ""
.Filters.Clear
.Show
End With
'error trap - don't allow user to pick more than 2000 files
If TargetFiles.SelectedItems.Count > MaxNumberFiles Then
MsgBox ("Too many files selected, please pick more than " & MaxNumberFiles & ". Exiting sub...")
Exit Sub
End If
'set up the output workbook
Set OutBook = ActiveWorkbook
Set OutSheet = ActiveWorkbook.Sheets(2)
'loop through all files
For FileIdx = 1 To TargetFiles.SelectedItems.Count
'open the file and assign the workbook/worksheet
Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
Set DataSheet = DataBook.ActiveSheet
'identify row/column boundaries
LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'if this is the first go-round, include the header
If FileIdx = 1 Then
Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(HeaderRow, 1), OutSheet.Cells(LastDataRow, LastDataCol))
'if this is NOT the first go-round, then skip the header
Else
Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 1), DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(LastOutRow + 1, 1), OutSheet.Cells(LastOutRow + 1 + LastDataRow, LastDataCol))
End If
'copy the data to the outbook
DataRng.Copy OutRng
'close the data book without saving
DataBook.Close False
'update the last outbook row
LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Next FileIdxAny help is very much appreciated.
