Include source sheet name to an output sheet - vba

Question

I'm trying to consolidate multiple sheets into one sheet and add a new column for the final "Combined" sheet. The new sheet should have a column named "Source" with the sheet name from where the rows behind it are copied.
Sub Final()
Path = " "
Filename = Dir(Path & "*.csv")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
thanks in advance for your help guys :)

Answer 1

The code below will copy the sheet's name inside the For J = 2 To ThisWorkbook.Sheets.Count loop to column B (first empty row equivalent to the data exists in Column A).
There are no Select, Selection and ActiveWorkbook, instead there are fully qualified objects like Workbooks, Worksheets and Ranges.
Also, when using On Error Resume Next you should also try to see where the error is coming from, and how to handle it. In your case, it's coming when trying to rename the new created sheet with the name "Combined" , and there is already a worksheet in your workbook with this name. The result is the code skips this line, and the worksheet's names stays wth the default name given by Excel (which is "Sheet" and first available index number).
Code
Option Explicit
Sub Final()
Dim wb As Workbook
Dim Sheet As Worksheet
Dim Path As String, FileName As String
Dim J As Long
Path = " "
FileName = Dir(Path & "*.csv")
Do While FileName <> ""
Set wb = Workbooks.Open(FileName:=Path & FileName, ReadOnly:=True)
For Each Sheet In wb.Sheets
Sheet.Copy after:=ThisWorkbook.Sheets(1)
Next Sheet
wb.Close
Set wb = Nothing
FileName = Dir()
Loop
On Error Resume Next
Set Sheet = Worksheets.Add(after:=Sheets(1))
Sheet.Name = "Combined"
If Err.Number <> 0 Then
Sheet.Name = InputBox("Combined already exists in workbook, select a different name", "Select new created sheet's name")
End If
On Error GoTo 0
Sheets(2).range("A1").EntireRow.Copy Sheets(1).range("A1")
For J = 2 To ThisWorkbook.Sheets.Count
With Sheets(J)
.Range("A1").CurrentRegion.Offset(1, 0).Resize(.Range("A1").CurrentRegion.Rows.Count - 1, .Range("A1").CurrentRegion.Columns.Count).Copy _
Destination:=Sheets(1).Range("A65536").End(xlUp)
Sheets(1).Range("B" & Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row).Value = .Name '<-- copy the sheet's name to column B
End With
Next J
End Sub

Answer 2

This will create a new sheet or clean the existing one and add 2 columns :
One for the source sheet
One for the source file
Give a try :
Sub Test_Matt()
Dim BasePath As String
Dim FileName As String
Dim tB As Workbook
Dim wB As Workbook
Dim wS As Worksheet
Dim wSCopied As Worksheet
Dim LastRow As Double
Dim ColSrcShtCombi As Integer
Dim ColSrcWbCombi As Integer
Dim wSCombi As Worksheet
Dim NextRowCombi As Double
Dim J As Integer
Set tB = ThisWorkbook
On Error Resume Next
Set wSCombi = tB.Sheets("Combined")
If wSCombi Is Nothing Then
Set wSCombi = tB.Sheets.Add
wSCombi.Name = "Combined"
Else
wSCombi.Cells.Clear
End If
On Error GoTo 0
With wSCombi
'''I don't know which sheet that is your take your headers from,
'''but here is where to define it:
tB.Sheets(2).Range("A1").EntireRow.Copy Destination:=wSCombi.Range("A1")
'''Add "Source"s columns
ColSrcShtCombi = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
.Cells(1, ColSrcShtCombi).Value = "Source Sheet"
ColSrcWbCombi = ColSrcShtCombi + 1
.Cells(1, ColSrcWbCombi).Value = "Source Workbook"
End With
'''Define here the folder you want to scan:
BasePath = "C:\Example\"
FileName = Dir(BasePath & "*.csv")
Do While FileName <> vbNullString
Set wB = Workbooks.Open(FileName:=BasePath & FileName, ReadOnly:=True)
For Each wS In wS.Sheets
Set wSCopied = wS.Copy(After:=tB.Sheets(tB.Sheets.Count))
'''Find next available row in Combined sheet
NextRowCombi = wSCombi.Range("A" & wSCombi.Rows.Count).End(xlUp).Row + 1
With wSCopied
'''Find the last row of data in that sheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'''Copy the data in Combined sheet
.Range("A2", .Cells(LastRow, .Cells(1, .Columns.Count).End(xlToLeft).Column)).Copy _
Destination:=wSCombi.Range("A" & NextRowCombi)
'''Put sheet's name and workbook's name in source columns
wSCombi.Range(wSCombi.Cells(NextRowCombi, ColSrcShtCombi), wSCombi.Cells(NextRowCombi + LastRow - 1, ColSrcShtCombi)).Value = wS.Name
wSCombi.Range(wSCombi.Cells(NextRowCombi, ColSrcWbCombi), wSCombi.Cells(NextRowCombi + LastRow - 1, ColSrcWbCombi)).Value = wB.Name
End With 'wSCopied
Next wS
wB.Close
FileName = Dir()
Loop
End Sub