Pasting file name at the end of each row

问题

I am trying to copy values from few excel files into one. I am trying to achieve that by first looping through directories and then files.

For Each cell In ThisWorkbook.Sheets("Info").Range("b8:b9")
    MsgBox (cell)
    strfile = Dir$(cell & "\" & "*.xlsm", vbNormal)

    While strfile <> ""
        MsgBox (strfile)
        ' Open the file and get the source sheet
        Set wbSource = Workbooks.Open(cell & "\" & strfile)
        Set inSource = wbSource.Sheets("OUTPUT_INSTRUMENT")
        Set enSource = wbSource.Sheets("OUTPUT_ENTITY")
        Set prSource = wbSource.Sheets("OUTPUT_PROTECTION")

        'Copy the data
        Call CopyHeaders(inSource, inTarget, enSource, enTarget, prSource, prTarget)
        Call CopyData(inSource, inTarget, enSource, enTarget, prSource, prTarget)

        'Close the workbook and move to the next file.
        wbSource.Close False
        strfile = Dir$()
    Wend
Next cell

Those are the values in B8:B9

C:\Users\gdsg\Desktop\One
C:\Users\gdsg\Desktop\Two

So when I copy the headers I am also adding additional column at the end. For each row pasted I need to add the source path (strfile) at the last column. I am trying with this but it doesn't work:

targetSht.Range(targetSht.Columns.Count & targetSht.Rows.Count).End(xlUp).Offset(1, 0).Value = strfile

Please find the additional definitions below. Source sheets are looped through the directory.

Set inTarget = ThisWorkbook.Sheets("Instrument")
Set enTarget = ThisWorkbook.Sheets("Entity")
Set prTarget = ThisWorkbook.Sheets("Protection")

Sub CopyData(ByRef inSource As Worksheet, inTarget As Worksheet, enSource As 
Worksheet, enTarget As Worksheet, prSource As Worksheet, prTarget As Worksheet)
CopySingleSheetData inSource, inTarget        
CopySingleSheetData enSource, enTarget        
CopySingleSheetData prSource, prTarget        
End Sub


Sub CopySingleSheetData(sourceSheet As Worksheet, targetSht As Worksheet)
With sourceSheet
    Intersect(.UsedRange, .Rows(5).Resize(.UsedRange.Rows.Count)).Copy
End With
targetSht.Range("A" & targetSht.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
targetSht.Range(targetSht.Columns.Count & targetSht.Rows.Count).End(xlUp).Offset(1, 0).Value = "dsdf"
Application.CutCopyMode = xlCopy
End Sub

回答1:

this should do:

change:

Call CopyData(inSource, inTarget, enSource, enTarget, prSource, prTarget, strFile) 

to:

CopyData inSource, inTarget, enSource, enTarget, prSource, prTarget, strFile ' Add 'strFile' to the passed parameters

change:

Sub CopyData(ByRef inSource As Worksheet, inTarget As Worksheet, enSource As Worksheet, enTarget As Worksheet, prSource As Worksheet, prTarget As Worksheet)
    CopySingleSheetData inSource, inTarget
    CopySingleSheetData enSource, enTarget
    CopySingleSheetData prSource, prTarget
End Sub

to:

Sub CopyData(ByRef inSource As Worksheet, inTarget As Worksheet, enSource As Worksheet, enTarget As Worksheet, prSource As Worksheet, prTarget As Worksheet, strFile As String) ' Add 'strFile' as an argument
    CopySingleSheetData inSource, inTarget, strFile ' pass 'strFile' as a parameter
    CopySingleSheetData enSource, enTarget, strFile ' pass 'strFile' as a parameter
    CopySingleSheetData prSource, prTarget, strFile ' pass 'strFile' as a parameter
End Sub

and finally change your CopySingleSheetData() sub to:

Sub CopySingleSheetData(sourceSheet As Worksheet, targetSht As Worksheet, strFile As String) ' Add 'strFile' as an argument
    Dim rngToCopy As Range
    With sourceSheet
        Set rngToCopy = Intersect(.UsedRange, .Rows(5).Resize(.UsedRange.Rows.Count))
    End With
    rngToCopy.Copy
    With targetSht.Range("A" & targetSht.Rows.Count).End(xlUp).Offset(1, 0)
        .PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = xlCopy
        .Offset(, rngToCopy.Columns.Count).Resize(rngToCopy.Rows.Count).value = strFile
    End With
End Sub

来源：https://stackoverflow.com/questions/49280523/pasting-file-name-at-the-end-of-each-row