Question

我在我的活动工作簿上放置了以下代码，该代码从已关闭的工作簿中复制数据。它工作得很好而且非常快，但如果我选择的不仅仅是我得到的话，我只能复制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 +行

Answer 1

尝试其他方法，使用复制＆gt;＆gt; 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

运行时错误＆＃39; 6＆＃39;溢出（来自已关闭工作簿的复制范围）

1 个答案: