在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

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

方法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