Question

我正在尝试将少数excel文件中的值复制到一个。我试图通过首先循环目录然后文件来实现这一点。

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

这些是B8中的值：B9

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

因此，当我复制标题时，我也会在最后添加其他列。对于每个粘贴的行，我需要在最后一列添加源路径（strfile）。我正在尝试这个但它不起作用：

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

请在下面找到其他定义。源表通过目录循环。

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

Answer 1

这应该做：

变化：

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

为：

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

变化：

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 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

最后将您的CopySingleSheetData()子更改为：

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

在每行末尾粘贴文件名

1 个答案: