Need to add a column in 90 workbooks which has the filename in every row

rlrjr · Jul 30th 2016

I have a folder of 90 excel files each named according to the date of the data within and where the single worksheet in each file has the exact same name. I need to combine the worksheets into a single worksheet, which I can easily do, but I need to differentiate among the data from the various sheets

Workbook1 named 12-2015.xlsx
Worksheet named Detail

Cust_ID Net_Sales
1023 $80
1027 $150

Workook2 named 01-2016.xlsx
Worksheet named Detail

Cust_ID Net_Sales
1023 $100
1027 $175

I need all the data combined on one sheet along with the date of the date (the Workbook name)

sktneer · Jul 30th 2016

Re: Need to add a column in 90 workbooks which has the filename in every row

You may try something like this......
Click the button on the sheet to run the code.

Code

Sub CombineFilesIntoOneFile()
Dim dwb As Workbook, swb As Workbook
Dim dws As Worksheet, sws As Worksheet
Dim slr As Long, slc As Long, dlr As Long
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim SeletedFolder As String


Application.ScreenUpdating = False
Set dwb = ThisWorkbook
Set dws = dwb.Sheets("Sheet1")
dws.Cells.Clear
dws.Range("A1:C1").Value = Array("Date", "Cust_ID", "Net_Sales")
Set fso = CreateObject("Scripting.FileSystemObject")


With Application.FileDialog(msoFileDialogFolderPicker)
   .Title = "Select A Folder!"
   .ButtonName = "Confirm"
   If .Show = -1 Then
      SelectedFolder = .SelectedItems(1)
      Set folder = fso.GetFolder(SelectedFolder)
   Else
      MsgBox "You didn't select a folder.", vbExclamation, "Folder Not Selected!"
      Exit Sub
   End If
End With
For Each file In folder.Files
   If InStr(file.Name, dwb.Name) = 0 And Left(fso.GetExtensionName(file), 2) = "xl" Then
      Workbooks.Open file
      Set swb = ActiveWorkbook
      Set sws = swb.Sheets(1)
      slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
      slc = sws.Cells(1, Columns.Count).End(xlToLeft).Column
      dlr = dws.Cells(Rows.Count, 2).End(xlUp).Row + 1
      dws.Range("A" & dlr).Value = Left(file.Name, InStr(file.Name, ".") - 1)
      sws.Range("A2", sws.Cells(slr, slc)).Copy dws.Range("B" & dlr)
      swb.Close True
   End If
   Set swb = Nothing
Next file
dws.Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "Data from all the Files have been copied into one Sheet successfully copied to all the Workbooks.", vbInformation, "Done!"
End Sub

Display More

rlrjr · Jul 31st 2016

Re: Need to add a column in 90 workbooks which has the filename in every row

[QUOTE=sktneer;774722]You may try something like this......
Click the button on the sheet to run the code.

I'm not sure what button I was supposed to click on, but I just pasted the code into a new module in ThisWorkbook, and then ran the macro. It worked perfectly. Thank you, this is brilliant and I am sure that there are many others looking for something like this.

Thanks again,

sktneer · Jul 31st 2016

Re: Need to add a column in 90 workbooks which has the filename in every row

You're welcome. Glad I could help.

The button I was referring to was placed on Sheet1 in the attached and named Combine Files.

Need to add a column in 90 workbooks which has the filename in every row

Participate now!

Share

Users Viewing This Thread