添加 VBA(从其他工作表中提取数据)例程后 Excel 文件变得太重

Question

我正在通过将其他工作表中的数据复制到主文件中来自动化 Excel 模型。我有一点问题，添加代码后文件从 25mb 变为 60mb，没有更改内容，只添加代码。您可以在下面找到我如何自动化导入的片段

Sub copytest() 'Procedure for retrieving data from the sourcefiles

    Dim wbTarget, wbSource As Workbook
    Dim target As Object
    Dim pathSource, fileName As String
    Dim xlApp As Application
    Dim lastRow As Long

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    'path where the data source folders are located (please keep all of them in the same directory)
    pathSource = "C:\Users\vferraz\Desktop\crm stock\RAPOARTE IMPORTANTE\18.02\Rapoarte pentru Handsets\"
    Set wbTarget = ThisWorkbook

    Set xlApp = CreateObject("Excel.Application")
    xlApp.DisplayAlerts = False
    Application.CutCopyMode = False

    'Stock 0001
    Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
    wbSource.Sheets(1).UsedRange.Copy
    wbSource.Close
    Set target = wbTarget.Sheets("Stock 0001")
    target.UsedRange.Clear
    Range("A1").Select
    target.Paste

    xlApp.Quit
    Set wbSource = Nothing
    Set xlApp = Nothing

    ThisWorkbook.Sheets("Mastersheet").Activate

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

在上面的片段中，我只添加了一个文件(Stock 0001)的解析，但对其他 10-15 个文件执行相同的方法。

有没有人有任何想法可以根据此过程提高此文件的效率/大小？

附言我知道“粘贴”方法可能只是添加格式而不是值，然后我尝试添加 .PasteSpecial xlPasteValues而不是粘贴，但它最终会引发我无法识别的错误

更新:

基于 this解决方案，这是我尝试过的新版本:

Stock 0001
    Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
    lastRow = wbSource.Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    wbTarget.Sheets("Stock 0001").Cells.Clear
    wbSource.Sheets(1).Range("A1:C" & lastRow).Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1")
    wbSource.Clo

行 wbSource.Sheets(1).Range("A1:C" & lastRow).Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1"抛出“范围类的复制方法失败错误。

Answer 1

而不是这个

'Stock 0001
Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
wbSource.Sheets(1).UsedRange.Copy
wbSource.Close
Set target = wbTarget.Sheets("Stock 0001")
target.UsedRange.Clear
Range("A1").Select
target.Paste

尝试这个

wbSource.Sheets(1).Columns("").Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1")

我放的地方 Columns只需通过 Range() 将其替换为您正在使用的任何范围或 Cells ETC
复制和粘贴需要一段时间，如果您已经在另一个位置复制某些内容，则会出现问题。这只是为您获取数据

此外，这段代码将是你永远的 friend

With Sheets("Sheet1")
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With

这将找到 A 列的底行(或您的“始终填充”列将是

Sub LastRow()

    Dim wb As Workbook, ws As Worksheet, LastRow As Long

    Set wb = ThisWorkbook
    Set ws = Worksheets("Data")

    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    With ws.Range(ws.Cells(2, 13), ws.Cells(LastRow, 13))
        'This is Range M2:M(bottom)
        .
        .
        'etc
        .
    End With

End Sub

编辑....3:

Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
Application.CutCopyMode = False

'Stock 0001
Set wbSource = xlApp.Workbooks.Open(pathSource & "Stock 0001.xls")

而不是所有这些，请使用

Set wbSource = Workbooks.Open(pathSource & "Stock 0001.xls")