excel - 从多个 Excel 文件复制单元格并将其粘贴到主文件中

Question

我得到了这个VBA代码，它应该从关闭的Excel文件(位于一个文件夹中)中读出单元格并将内容复制到主文件中。 它似乎按预期读出了文件，但是粘贴复制的内容似乎不起作用。

有什么想法吗？

Sub ReadAndMerceData()

Dim objFs As Object
Dim objFolder As Object
Dim file As Object

Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder("C:\Users\XXX\Desktop\TEST")

Dim iStartRow As Integer
iStartRow = 0

For Each file In objFolder.Files

    Dim src As Workbook
    Set src = Workbooks.Open(file.Path)

    Dim iTotalRows As Integer
    iTotalRows = 50

    Dim iTotalCols As Integer
    iTotalCols = 17
    Dim iRows, iCols As Integer

    For iRows = 1 To iTotalRows
        For iCols = 1 To iTotalCols
            Cells(iRows + iStartRow, iCols) = src.Worksheets("Tabelle1").Cells(iRows, iCols)
        Next iCols
    Next iRows

    iStartRow = iRows + 1
    iRows = 0

    src.Close False
    Set src = Nothing
Next

End Sub

Answer 1

您不需要逐个单元格地复制。您可以一次复制整个范围，这要快得多。

另请确保指定要复制到的工作簿和工作表。切勿在未指定工作表的情况下使用 Range 或 Cells(否则 Excel 会猜测并且可能是错误的)。

Option Explicit

Public Sub ReadAndMerceData()
    Dim objFs As Object        
    Set objFs = CreateObject("Scripting.FileSystemObject")

    Dim objFolder As Object
    Set objFolder = objFs.GetFolder("C:\Users\XXX\Desktop\TEST")

    Dim dest As Worksheet 'define your destination sheet!
    Set dest = ThisWorkbook.Worksheets("DestinationSheet")

    'make them variabes if they are dynamic otherwise use constants if hardcoded.
    Const TotalRows As Long = 50
    Const TotalCols As Long = 17 

    Dim iStartRow As Long

    Dim file As Object
    For Each file In objFolder.Files
        Dim src As Workbook
        Set src = Workbooks.Open(file.Path)

        'copy all cells at once
        dest.Cells(iStartRow + 1, 1).Resize(TotalRows, TotalCols).Value = src.Worksheets("Tabelle1").Cells(1, 1).Resize(TotalRows, TotalCols).Value

        iStartRow = iStartRow + TotalRows + 1

        src.Close SaveChanges:=False
    Next file
End Sub

说明

此 dest.Cells(iStartRow + 1, 1) 是我们要复制到的第一个单元格，因此使用 .Resize(TotalRows, TotalCols) 我们展开该单元格到一个范围并将其 .Value 设置为等于从第一个单元格 src.Worksheets("Tabelle1").Cells(1, 1) 开始的源工作表范围具有相同数量的行和列.Resize(TotalRows, TotalCols)。

请注意，复制整个范围始终比逐个单元格复制相同数据要快，因为只需执行 1 次复制操作。