vba to copy and paste each file name

[abenny]

I have this loop that opens excel files on a sharepoint site adds the file name to column U in the destination file and all the other data in column A:M.

I would like the script to copy the file name in all rows for each of the excel files on the destination file. This line below is where the file name gets added to only the first row found in column U

SummarySheet.Range("U" & NRow).Value = FileName

I attached the results from the original script. I need column U to populate all rows with the filename for each workbook

loop results.xlsx

Sub PullDatafromSharepoint()

Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim imgTitle As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim FolderName As String
Dim LR As Long
Dim x As Long
Dim n As Integer
Dim temp As Long
Dim rng As Range, ar As Range
Dim nr As Range
Dim mr As Range
Dim LoginName As String
Dim WinShuttle As Application
Dim Connection As Object
Dim session As Object
Dim SAPApp As Object
Dim SAPCon As Object, SAPSesi As Object
Dim SAPGUIAuto As Object
Dim sapConnection As Object
Dim d As String, ext, y
Dim SrRan As String
Dim srcPath As String, destPath As String, srcFile As String
Application.ScreenUpdating = False






LoginName = UCase(GetUserID)


'Designates Sheet for pasting from multiple workbooks
Set SummarySheet = Worksheets(3)




'Modify folder path when transferring between process owners
FolderPath = "Z:\"


'Nrow keeps track of where to insert new rows in the workbook
NRow = 1
'LR = ActiveSheet.Range("U" & Rows.Count).End(xlUp).Row
'Call directory the first time pointing it to all excel files
FileName = Dir(FolderPath & "*.xls*")
'Loop until directory returns empty string
Do While FileName <> ""
    'Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & FileName)


   'Set the cell in column U to house the file name
    SummarySheet.Range("U" & NRow).Value = FileName
    
    
    
    'Set the range to be A1000 through W1000
    On Error Resume Next
    Set SourceRange = WorkBk.Worksheets(1).Range("A2:M300")
    SrRan = Dir(FolderPath & "*.xls*")
    On Error GoTo 0
    'Set the destination range
    Set DestRange = SummarySheet.Range("A" & NRow)
    Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
    
    'Copy over values from the source to the destination
    DestRange.Value = SourceRange.Value
   
    
    'Increase NRow so that data moves down
    NRow = NRow + DestRange.Rows.Count
    'Close source workbook
    WorkBk.Close SaveChanges:=False
    
    'Use Dir to get to the next file name
    FileName = Dir()
Loop

[MINCUS1308]

Pretty sure I can do it but I'm not sure I understand this part.

...copy the file name in all rows for each of the excel files on the destination file.

Can you phrase it in a different way?

[abenny]

QUOTE=MINCUS1308;371592]Pretty sure I can do it but I'm not sure I understand this part.

...copy the file name in all rows for each of the excel files on the destination file.

Can you phrase it in a different way?[/QUOTE]


On the attachment in the original post "loop results.xlsx" you can see in column U only the first line in each file gets the file name populated. The attachment below "desired loop results.xlsx" is how I need the file name populated in column U

desired loop results.xlsx[