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

这些文件夹中的每一个都有多个文件，我们首先检查这两个目录，然后查看DIR()的所有文件。也许一种方法是用While替换For each循环？

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

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)

inSource.Range("5" & ":" & inSource.Rows.Count).Copy
inTarget.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

enSource.Range("5" & ":" & enSource.Rows.Count).Copy
enTarget.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

prSource.Range("5" & ":" & prSource.Rows.Count).Copy
prTarget.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = xlCopy

End Sub

Answer 1

尝试使用此代码将多个Excel合并为一个

--insecure

它会起作用

Answer 2

它是因为您尝试粘贴更多行，然后才能

与

inSource.Range("5" & ":" & inSource.Rows.Count).Copy

您正在复制所有源表格行，但是前五行，而

inTarget.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

您从目标表格中粘贴它们从A列中最后一个非空值之后的行开始

但如果后一个索引大于5，那么你的目标表没有空间容纳所有这些行

因此您必须复制实际需要的确切行数

然后你可以考虑这个助手子

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
    Application.CutCopyMode = xlCopy
End Sub

您可以从CopyData()子系统拨打电话，如下所示

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

同时循环遍历目录和文件

2 个答案: