我在我的活动工作簿上放置了以下代码,该代码从已关闭的工作簿中复制数据。它工作得很好而且非常快,但如果我选择的不仅仅是我得到的话,我只能复制8列
运行时错误6 - 溢出
代码:
Sub Get_Data()
Dim RngToCopy As Range
Dim wkbk As Workbook
Dim DestCell As Range
Dim myFileNames As Variant
Dim iCtr As Long
Dim testStr As String
Set DestCell = ThisWorkbook.Worksheets(1).Range("a1")
myFileNames = Array("C:\my documents\excel\book1.xlsm") ' i could add more workbooks to copy from and append on current worksheet
For iCtr = LBound(myFileNames) To UBound(myFileNames)
testStr = ""
On Error Resume Next
testStr = Dir(myFileNames(iCtr))
On Error GoTo 0
If testStr = "" Then
MsgBox myFileNames(iCtr) & " doesn't exist!"
Else
Set wkbk = Workbooks.Open(Filename:=myFileNames(iCtr))
With wkbk.Worksheets(1)
Set RngToCopy = .Range("a2:r2", _
.Cells(.Rows.Count, "A").End(xlUp))
End With
DestCell.Resize(RngToCopy.Rows.Count, _
RngToCopy.Columns.Count).Value _
= RngToCopy.Value
Set DestCell = DestCell.Offset(RngToCopy.Rows.Count, 0)
wkbk.Close savechanges:=False
End If
Next iCtr
End Sub
当我调试它所涉及的行时:我在哪里错了:(
DestCell.Resize(RngToCopy.Rows.Count, _
RngToCopy.Columns.Count).Value _
= RngToCopy.Value
源工作簿是一个包含大量数据的大文件,我在研究错误时尝试了大部分建议,但没有运气。
如果它有助于工作簿包含18列和300k +行
答案 0 :(得分:0)
尝试其他方法,使用复制>> PasteSpecial (仅限值):
' 1st: set copy range
With wkbk.Worksheets(1)
Set RngToCopy = .Range("A2:R2", .Cells(.Rows.Count, "A").End(xlUp))
End With
' 2nd: set destination range start position
Set DestCell = DestCell.Offset(RngToCopy.Rows.Count, 0)
' 3rd: use copy>>paste special (values only)
RngToCopy.Copy
DestCell.PasteSpecial xlPasteValues