Избавление от буфера обмена при копировании больших диапазонов в другую книгу?

Question

Я заинтересован в копировании большого диапазона из одной книги в другую. В настоящее время я использую функции копирования и вставки. Макрос работал с меньшими файлами, но теперь у меня очень большой файл, и я нахожусь в ошибке на ActiveSheet.Paste. Я думаю, что это потому, что то, что я копирую, слишком велико для буфера обмена. Правильно ли это звучит? Если это так, я хотел бы избежать обмена буфером все вместе. Вот мой код в настоящее время.

DeptReceivedWB.Sheets(1).Cells(1, 1).CurrentRegion.Copy 


APPS_AuditWB.Activate 
APPS_AuditWB.Sheets(3).Select 
ActiveSheet.Cells(i + 1, 1).Select 
ActiveSheet.Paste 
ActiveSheet.Cells(i + 1, 1).EntireRow.Delete 

Answer 1

Используйте один из них:

Option Explicit 

Public Sub valuesCopy() 
    With DeptReceivedWB.Sheets(1).Cells(1, 1).CurrentRegion 
     .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Copy 
    End With 

    APPS_AuditWB.Sheets(3).Cells(1, 1).PasteSpecial xlPasteValues 
End Sub 

Public Sub directCopy1() 
    Dim cr As Range, fr As Long, lr As Long, fc As Long, lc As Long 

    Set cr = DeptReceivedWB.Sheets(1).Cells(1, 1).CurrentRegion 
    fr = cr.Row: lr = fr + cr.Rows.Count - 2 
    fc = cr.Column: lc = fc + cr.Columns.Count - 1 
    Set cr = cr.Offset(1).Resize(lr, lc) 

    With APPS_AuditWB.Sheets(3) 
     .Range(.Cells(fr, fc), .Cells(lr, lc)).Value2 = cr.Value2 
    End With 
End Sub 

Public Sub directCopy2() 
    Dim cr As Range, fr As Long, lr As Long, fc As Long, lc As Long 

    Set cr = DeptReceivedWB.Sheets(1).Cells(1, 1).CurrentRegion 
    fr = cr.Row: lr = cr.Rows.Count - 1 
    fc = cr.Column: lc = cr.Columns.Count 
    Set cr = cr.Offset(1).Resize(lr, lc) 

    With APPS_AuditWB.Sheets(3) 
     .Cells(fr, fc).Resize(lr, lc).Value2 = cr.Value2 
    End With 
End Sub 

Answer 2

Я хотел бы предложить, что вы только скопировать диапазон, который вы хотите, а не копирование (предположительно) строку заголовка, а затем удалить его из мишени:

Dim rgCopy as range 
set rgCopy = DeptReceivedWB.Sheets(1).Cells(1, 1).CurrentRegion 
set rgCopy = rgCopy.Resize(rgCopy.Rows.Count - 1).Offset(1) 
rgCopy.Copy Destination:=APPS_AuditWB.Sheets(3).Cells(i + 1, 1)