在循环中从模板工作簿创build工作簿

我试图找出最有效的方式来筛选大表中的数据，筛选它，并将筛选的数据复制到新的工作表。 下面是我有的代码 – 哪些工作，但需要一分钟才能完成。 我的最终目标是采取一个模板工作簿（包括我所有的数据），并根据过滤的数据创build子工作簿。 我试图使用SaveCopyAs创build子工作簿，但我最终失去了我的原始数据。 所以，我试图将过滤的数据复制到不同的工作表作为解决方法。 请帮忙！

  wsDV.ListObjects("DVTable").Range.AutoFilter Field:=2, Criteria1:=wsMaster.Range("F" & x) Application.DisplayAlerts = False On Error Resume Next wsDV.ListObjects("DVTable").HeaderRowRange.Copy Destination:=wsSalary.Range("C3") wsDV.ListObjects("DVTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy wsSalary.Range("C4").PasteSpecial xlPasteValues Application.CutCopyMode = False 

谢谢。

Answer 1

有很小的应用程序更改可以做到调整速度

closures更新和事件:(确保将它们重新打开！）

 Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False 

但是，最大的改进将来自删除复制/粘贴操作 – 尤其是使用剪贴板 – 如果你只是粘贴值，你可以做到这一点。

直接添加范围值

改变这个：

 wsDV.ListObjects("DVTable").HeaderRowRange.Copy Destination:=wsSalary.Range("C3") wsDV.ListObjects("DVTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy wsSalary.Range("C4").PasteSpecial xlPasteValues 

为此：

 Dim rgeFrom As Range Dim rgeTo As Range Dim numCols As Long Dim startCol As Long Dim startRow As Long Dim endCol As Long Dim endRow As Long Set rgeFrom = wsDV.ListObjects("DVTable").HeaderRowRange numCols = rgeFrom.Columns.Count numRows = rgeFrom.Rows.Count startCol = 3 ' wsSalary Start Cell C3 startRow = 3 endCol = startCol + numCols - 1 endRow = startRow + numRows - 1 Set rgeTo = Range(Cells(startRow, startCol), Cells(endRow, endCol)) rgeTo.Value = rgeFrom.Value ' Do same for next range DataBodyRange Set rgeFrom = wsDV.ListObjects("DVTable").DataBodyRange numCols = rgeFrom.Columns.Count numRows = rgeFrom.Rows.Count startCol = 3 ' wsSalary Start Cell C4 startRow = 4 endCol = startCol + numCols - 1 endRow = startRow + numRows - 1 Set rgeTo = Range(Cells(startRow, startCol), Cells(endRow, endCol)) rgeTo.Value = rgeFrom.Value