macro to extract Fle Names into Col J when Imported

[howard]

I have the following macro below.

I would like to extract the file names in Col J for each of the rows pertaining to the files imported that is applicable for each file

It would be appreciated if someone could amend my code to show the file names in col J

See sample data where I have manually shown the File names in Col J

MatchDebits and Credits Based similar text in Narrative.xlsx
	A	B	C	D	E	F	G	H	I	J
1	Reference	Source	Run	A/C	Date	Debit	Credit	Balance	Narrative	Branch
2	1983	Purchase Ordering	5355		17/06/2021	390	0	390	983 fuel refunds	BR1 Sales June 2021.csv
3	792	Purchase Ordering	5352		17/06/2021	212.21	0	212.21	978 fuel-Fuel	BR1 Sales June 2021.csv
4	077	Purchase Ordering	5353		17/06/2021	203.78	0	203.78	834 fuel -Fuel	BR1 Sales June 2021.csv
5	272	Purchase Ordering	4801		04/06/2021	200.92	0	200.92	226 Fuel UP -Fuel	BR1 Sales June 2021.csv
6	484	Nom	4803		18/06/2021		805.99	-805.99	Fuel	BR2 Sales June 2021.csv
Sheet1

Cell Formulas
Range	Formula
H2:H6	H2	=+F2-G2

 Sub Open_MultipleFiles()

Application.DisplayAlerts = False

ChDir "C:\Extract"

Dim LR As Long
With Sheets("Reconciling Items")

LR = .Cells(.Rows.Count, "A").End(xlUp).Row

.Range("A1:J" & LR).ClearContents


Dim fDialog As Object, varFile As Variant

Dim nb As Workbook, tw As Workbook, ts As Worksheet

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

.CutCopyMode = False

End With

Set tw = ThisWorkbook

Set ts = tw.ActiveSheet

Set fDialog = Application.FileDialog(3)

ChDir "C:\extract"

With fDialog

.Filters.Clear

.Filters.Add "Excel files", "*.csv*"

.Show



For Each varFile In .SelectedItems

Set nb = Workbooks.Open(Filename:=varFile, local:=True)



With Sheets(1)

.Range("A1:I500").Copy

ThisWorkbook.Sheets("Reconciling Items").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

With ThisWorkbook.Sheets("Reconciling Items").Range("A" & Rows.Count).End(xlUp).Offset(1)

.PasteSpecial xlPasteFormats


End With

End With

nb.Close False

Next

End With

With Sheets("Reconciling Items")

.Range("A1").EntireRow.Delete

.Range("A:J").EntireColumn.AutoFit

End With
With Application

.ScreenUpdating = True

.Calculation = xlCalculationAutomatic

.CutCopyMode = True

End With


End With

ChDir "C:\my documents"

Application.DisplayAlerts = True
End Sub

Your assistance is most appreciated

 

[howard]

Justo inform you that I have managed to sort this out by adding this code below

 .Range("j1").Value = varFile

After

[/code] With ThisWorkbook.Sheets("Reconciling Items").Range("A" & Rows.Count).End(xlUp).Offset(1)
.PasteSpecial xlPasteFormats [/code]