Add each csv filename to end of each row in excel

[Lola223]

Hi,

I am using the following VBA to loop through several csv files and copy the data into a worksheet on the active workbook the code is run from.

I would like to add the filename to the end of each row so that I know which file the copied data row has come from.

Public strPath As Range

Sub CopyRange()

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Dim wkbDest As Workbook

Dim wkbSource As Workbook

Set wkbDest = ThisWorkbook

Dim LastRow As Long

Set strPath = Worksheets("Combine Dataset").Range("B1")

strExtension = Dir("*.csv*")

Do While strExtension <> ""

Set wkbSource = Workbooks.Open(strPath & strExtension)

With wkbSource

LastRow = .ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

.ActiveSheet.Range("A5:K" & LastRow).Copy wkbDest.Sheets("Banking Combined").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

.Close savechanges:=False

End With

strExtension = Dir

Loop

Application.ScreenUpdating = True

End Sub

 

[Candyman8019]

you can use ActiveWorkbook.Name in vba to grab the filename.

 

[Lola223]

I am not sure how to incorporate this into my existing code.

 

[Candyman8019]

Without actually seeing your workbook, I'm assuming column K is the last populated column. Give this a try...
after this row
.ActiveSheet.Range("A5:K" & LastRow).Copy wkbDest.Sheets("Banking Combined").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
add
activesheet.range("L" & Lastrow).value = ActiveWorkbook.Name

 

[Lola223]

I've tried adding that to my code and nothing is being populated. Having stepped through the code, it is giving me the name of the active workbook I am running the code from rather than the csv file I am pulling the data from

My code is a little bit different t from what I pasted above actually and I've added a line as to what I think would be needed but getting an error

Sub CopyRange()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim LastRow As Long
Set strPath = Worksheets("Combine Dataset").Range("B1")
strExtension = Dir(strPath & "*.csv*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource
LastRow = .ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.ActiveSheet.Range("A2:L" & LastRow).Copy wkbDest.Sheets("HybridMI Combined").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Workbooks("Hybrid MI Template.xlsm").Worksheets("HybridMI Combined").Cells("M" & LastRow).Value = strExtension
.Close savechanges:=False
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Data merge completed"
End Sub

 

[Candyman8019]

Just so I have this clear. This code is in a module within "Hybrid MI Template.xlsm"?

which row is giving you the error? If you step through with F8 you should be able to see where it is failing.

 

[Lola223]

Yes the code is in a module within Hybrid Mi Template.xlsm

It fails at the line starting Workbooks(Hybrid MI Template.xlsm which is the line I've added to try and add the csv filename to row M. If I put ' in this line so it represents a comment then the code runs fine without the filename being input in the row of course which is what I am trying to achieve

 

[Candyman8019]

try changing that line to:
Workbooks("Hybrid MI Template.xlsm").Worksheets("HybridMI Combined").Cells("M" & LastRow).Value = Worksheets("Combine Dataset").Range("B1").value & ".csv"

 

[Lola223]

try changing that line to:
Workbooks("Hybrid MI Template.xlsm").Worksheets("HybridMI Combined").Cells("M" & LastRow).Value = Worksheets("Combine Dataset").Range("B1").value & ".csv"

This gives me a subscript out of range error

 

[Candyman8019]

what value is in Worksheets("Combine Dataset").Range("B1").value

can you share a sample of your sheet with xl2bb?