VBA将大量数据从多个工作簿导入到主表中

我的代码当前打开一个文件select器，并select文件和特定的列我感兴趣的是合并到我的主工作表。

我select了几个.csv文件，并引入我select的一列。

问题我有，

1）这些文件很大，400kb。

2）我得到运行时错误1004，复制区域和粘贴区域大小和形状不一样。 我只是在excel表单上空间不足？ 当我debugging我得到错误行copyRng.Copy destRng

我的最终目标是查看并计算来自所有工作簿的Col C（也许还有其他一些列）的唯一值。

 Option Explicit Dim wsMaster As Workbook, csvFiles As Workbook Dim Filename As String Dim File As Integer Dim r As Long Public Sub Consolidate() With Application .ScreenUpdating = False .EnableEvents = False End With With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Title = "Select files to process" .Show If .SelectedItems.Count = 0 Then Exit Sub Set wsMaster = ActiveWorkbook Dim copyRng As Range, destRng As Range Dim firstRow As Long For File = 1 To .SelectedItems.Count Filename = .SelectedItems.Item(File) If Right(Filename, 4) = ".csv" Then Set csvFiles = Workbooks.Open(Filename, 0, True) r = wsMaster.Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row '' This is the main new part Set copyRng = csvFiles.Sheets(1).Range("C1:C" & r) With wsMaster.Sheets("Sheet1") firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row Set destRng = .Range("A" & firstRow + 1).Offset(0, 1) End With copyRng.Copy destRng '''''''''' csvFiles.Close SaveChanges:=False 'close without saving End If Next File End With Set wsMaster = Nothing Set csvFiles = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

更新了以下build议的代码

 Option Explicit Dim wsMaster As Workbook, csvFiles As Workbook Dim Filename As String Dim File As Integer Dim r As Long Public Sub Consolidate() With Application .ScreenUpdating = False .EnableEvents = False End With With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Title = "Select files to process" .Show If .SelectedItems.Count = 0 Then Exit Sub Set wsMaster = ActiveWorkbook Dim copyRng As Range, destRng As Range Dim firstRow As Long For File = 1 To .SelectedItems.Count Filename = .SelectedItems.Item(File) If Right(Filename, 4) = ".csv" Then Set csvFiles = Workbooks.Open(Filename, 0, True) r = csvFiles.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row '' This is the main new part Set copyRng = csvFiles.Sheets(1).Range("C1:C" & r) With wsMaster.Sheets("Sheet1") firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 Set destRng = .Range("B" & firstRow & "B" & (firstRow + r)) End With destRng.Value = copyRng.Value '''''''''' csvFiles.Close SaveChanges:=False 'close without saving End If Next File End With Set wsMaster = Nothing Set csvFiles = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

Answer 1

由于行数由r定义，所以可以设置目标范围的尺寸。 下面的修改应该修复复制粘贴错误，并通过消除剪贴板的使用（假设你只想复制这些值）来加速你的代码。

 If Right(Filename, 4) = ".csv" Then Set csvFiles = Workbooks.Open(Filename, 0, True) r = csvFiles.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row '' This is the main new part Set copyRng = csvFiles.Sheets(1).Range("C1:C" & r) With wsMaster.Sheets("Sheet1") firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 Set destRng = .Range("B" & firstRow & ":B" & (firstrow + r)) End With DestRng.value = CopyRng.value '''''''''' csvFiles.Close SaveChanges:=False 'close without saving End If