在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