Copying Existing Sheets in Excel Slows down my VBA code significantly

Question

I've been building a program to create invoices dependent on the number of clients/owners my company is interacting with. For every one client, we potentially have multiple owners, what we do is create an individual invoice for each owner. My problem is that the code is designed to copy a template sheet and then edit it accordingly, this copying process slows down my code to between 10 and 20 seconds (I have a timer in the code).

Is there any other way I could more efficiently do this? I have an image in the sheet which does not copy over well when I simply try to create a new sheet and then copy/paste from the template sheet. Any other ideas?

Thanks!

Edit:

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

Based on the method in my comment, I did a test with my own (very simple) template that is shown below for full disclosure:

Method 1 (Your Code)

it took 0.09375 seconds to complete.

EDIT: Method 2 (based on Bruce Wayne's Comment)

it took .015625 seconds to complete! That is 6xs as fast!

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

Method 3 (Based on My Comment)

it took 0.03125 seconds to complete! That is 3Xs as fast!

Code is below:

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