Code to Include File name in the macro for merging data from workbooks to Worksheet

[flakedew]

The macro merges all the data from excel files in the specific folder into the sheet named Master.
The data extends from Col. A to Col.Y.

Sub Button1_Click()
'Summary: Merge files in a specific folder into one master sheet (stacked)
' Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.DisplayAlerts = False 
Set wsMaster = ThisWorkbook.Sheets("Master") 'sheet report is built into
With wsMaster
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
.UsedRange.Offset(1).EntireRow.Clear
NR = 2
Else
NR = .Range("a" & .Rows.Count).End(xlUp).Row + 1 
End If
 
MsgBox "Please select a folder with files to consolidate"
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\2010\Test\"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
fPath = .SelectedItems(1) & "\"
Exit Do
Else
If MsgBox("No folder chose, do you wish to abort?", _
vbYesNo) = vbYes Then Exit Sub
End If
End With
Loop
fPathDone = fPath & "Imported\" 
On Error Resume Next
MkDir fPathDone 
On Error GoTo 0
fName = Dir(fPath & "*.xls*")
'Import a sheet from found files
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
Set wbData = Workbooks.Open(fPath & fName) 'Open file
'This is the section to customize, replace with your own action code as needed
LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
wbData.Close False 'close file
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
End If
fName = Dir 'ready next filename
Loop
End With
ErrorExit: 'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True 
Application.EnableEvents = True 
Application.ScreenUpdating = True 
End Sub

The requirement is

The filename( excluding extension, .xls, .xlsx, .xlsm etc) to be included in Col.Z for each entry from the particular file.

 

[drsarao]

Try this:
.Range("Z" & NR) = Left(wbData.Name, InStr(wbData.Name, ".xl") - 1)

 

[flakedew]

thanks for the response...In the merged Master sheet, with the code given by you, the filename is displayed only for the first entry of particular Workbook.I need the code to update the filename for all the entries of the particular workbook, when it merges in Master Sheet.Please help

 

[drsarao]

Try this:

If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
    Set wbData = Workbooks.Open(fPath & fName) 'Open file
    'This is the section to customize, replace with your own action code as needed
    lr = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
    Range("A1:A" & lr).EntireRow.Copy .Range("A" & NR)
    wbData.Close False 'close file
    [COLOR="#FF0000"]oldNR = NR[/COLOR]
    NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
    [COLOR="#FF0000"].Range("Z" & oldNR & ":Z" & NR - 1) = Left(wbData.Name, InStr(wbData.Name, ".xl") - 1)[/COLOR]
    Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
End If

 

[flakedew]

I had copies ur code and pasted in the macro.
I added Dim oldNR as long

i get a Run time error " Method Name of Object _ workbook failed on the line
.Range("Z" & oldNR & ":Z" & NR - 1) = Left(wbData.Name, InStr(wbData.Name, ".xl") - 1)

 

[drsarao]

Shift wbData.Close False to end.

If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
    Set wbData = Workbooks.Open(fPath & fName) 'Open file
    'This is the section to customize, replace with your own action code as needed
    lr = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
    Range("A1:A" & lr).EntireRow.Copy .Range("A" & NR)
    oldNR = NR
    NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
    .Range("Z" & oldNR & ":Z" & NR - 1) = Left(wbData.Name, InStr(wbData.Name, ".xl") - 1)
    [COLOR="#FF0000"] wbData.Close False 'close file[/COLOR]
     Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
End If

 

[flakedew]

thanks a lot
working perfect

 

[drsarao]

You are welcome and thanks for the feedback!