时间戳

首页 > 解决方案 > 从多个excel文件复制单元格并将它们粘贴到主文件中

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

问题描述

我得到了这个 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

标签： excelvba

解决方案

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

还要确保指定要复制到的工作簿和工作表。永远不要使用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 个复制操作。

推荐阅读