在Excel中复制现有的表格显着减慢我的VBA代码

我一直在build立一个程序来创build发票依赖于我的公司正在与之交互的客户/业主的数量。 对于每一个客户，我们可能有多个所有者，我们所做的是为每个所有者创build一个单独的发票。 我的问题是，代码被devise为复制模板，然后相应地编辑它，这个复制过程减慢了我的代码在10到20秒之间（我在代码中有一个计时器）。

有没有其他办法可以更有效地做到这一点？ 我在工作表中有一张图片，当我只是尝试创build一个新工作表，然后从模板工作表中复制/粘贴时，工作表中的图片不能很好地复制。 任何其他的想法？

谢谢！

编辑：

Private Sub CommandButton1_Click() Dim t As Single t = Timer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Sheets("Client Invoice Template").Visible = True Sheets("Client Invoice Template").Visible = True Sheets("Client Invoice Template").Copy Before:=Sheets(3) Sheets("Client Invoice Template (2)").Name = "Client Invoice" Sheets("Client Invoice Template").Visible = False Sheets("Select").Select Application.Calculation = xlCalculationAutomatic MsgBox Timer - t End Sub 

Answer 1

根据我评论中的方法，我用我自己的（非常简单的）模板做了一个testing，如下所示，

方法1（您的代码）

完成时间为0.09375秒。

编辑：方法2（基于布鲁斯·韦恩的评论）

完成了.015625秒！ 这是6 倍速 ！

 Sub CommandButton3_Click() Dim t As Single t = Timer With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim wsT As Worksheet, ws As Worksheet Set wsT = Sheets("Client Invoice Template") wsT.Visible = True 'view template Set ws = Sheets.Add(Before:=Sheets(3)) 'add new sheet With wsT 'copy row height and column width 'row height Dim rng as Range For each rng in .range("A1:A100") ws.Rows(rng.Row).RowHeight = rng.Height Next 'column width For each rng in .Range("A1:D1") ws.Columns(rng.Column).ColumnWidth = rng.Width Next wsT.Range("A1:D100").Copy 'copy template data (change range accordingly) With ws .Range("A1").PasteSpecial xlPasteValues 'past values (change range accordingly) .Range("A1").PasteSpecial xlPasteFormats 'past formats (change range accordingly) .Pictures.Insert("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg").Select With .Shapes("Picture 1") .Top = ws.Range("B2").Top 'adjust as needed .Left = ws.Range("B2").Left 'adjust as needed .Height = 126.72 'adjust as needed .Width = 169.2 'adjust as needed End With .Name = "Client Invoice" End With wsT.Visible = False Application.Calculation = xlCalculationAutomatic Debug.Print Timer - t End Sub 

方法3（基于我的评论）

完成了0.03125秒！ 这是3 倍的速度！

代码如下：

 Sub CommandButton2_Click() Dim t As Single t = Timer With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim wsT As Worksheet, ws As Worksheet Set wsT = Sheets("Client Invoice Template") wsT.Visible = True 'view template Set ws = Sheets.Add(Before:=Sheets(3)) 'add new sheet wsT.Range("A1:D100").Copy 'copy template data (change range accordingly) With ws .Range("A1").PasteSpecial xlPasteValues 'past values (change range accordingly) .Range("A1").PasteSpecial xlPasteFormats 'past formats (change range accordingly) End With wsT.Shapes("Picture 1").Copy 'change to your picture name accordingly With ws .Range("B2").PasteSpecial 'paste to cell (change range accordingly) .Name = "Client Invoice" 'rename End With wsT.Visible = False Application.Calculation = xlCalculationAutomatic Debug.Print Timer - t End Sub