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

Question

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

还有其他方法可以更有效地做到这一点吗？当我只是尝试创建一个新工作表然后从模板工作表中复制/粘贴时，我在工作表中有一个图像不能很好地复制。还有其他想法吗？

谢谢！

编辑：

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

根据我评论中的方法，我使用自己的（非常简单的）模板进行了测试，该模板如下所示，以便完整披露：

multiple backgrounds

方法1（您的代码）

完成 0.09375 秒。

编辑：方法2（基于Bruce Wayne的评论）

完成了 .015625 秒！那是 6xs 一样快！

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 秒完成！那是 3Xs 一样快！

代码如下：

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