Faster way of VBA to copy worksheet to new workbook

Is there a faster way to copy worksheet to new workbook using the VBA code below as reference? I only need to copy specific sheets to a new workbook and then remove all workbook links. Thank you in advance.


Sub ExtractTaxAnnualizationCopy()

If Sheets("EID_Tax Calculator").Range("C2").Value = 0 Then

'Copy specific sheets only
Worksheets(Array("Tax Annualization Copy", "13th Month Pay Copy", "EstimatedTaxableIncome Copy")).Copy

Else

Worksheets(Array("Tax Annualization Copy", "YTD Copy", "Pivot YTD Static Copy", "13th Month Pay Copy", "EstimatedTaxableIncome Copy")).Copy

End If

'Remove workbook links
Dim ar As Variant
Dim i As Integer

ar = ActiveWorkbook.LinkSources(1)

On Error Resume Next 'Trap error

For i = 1 To UBound(ar) 'Excel VBA loop throuh links
ActiveWorkbook.BreakLink ar(i), xlLinkTypeExcelLinks
Next i

On Error GoTo 0


End Sub

Does it help if you disable calculation and screen updating?
NB: On Error Resume Next is ignoring any errors, not trapping them.

Sub ExtractTaxAnnualizationCopy()
DisableSettings (True)
If Sheets("EID_Tax Calculator").Range("C2").Value = 0 Then
    'Copy specific sheets only
    Worksheets(Array("Tax Annualization Copy", "13th Month Pay Copy", "EstimatedTaxableIncome Copy")).Copy
Else
    Worksheets(Array("Tax Annualization Copy", "YTD Copy", "Pivot YTD Static Copy", "13th Month Pay Copy", "EstimatedTaxableIncome Copy")).Copy
End If

'Remove workbook links
Dim ar As Variant
Dim i As Integer

On Error Resume Next 'IGNORE error

    ar = ActiveWorkbook.LinkSources(1)
    For i = 1 To UBound(ar) 'Excel VBA loop throuh links
    ActiveWorkbook.BreakLink ar(i), xlLinkTypeExcelLinks
    Next i

On Error GoTo 0
DisableSettings (False)
End Sub

Sub DisableSettings(v As Boolean)
v = Not v
With Application
    .ScreenUpdating = v
    .DisplayAlerts = v
    .Calculation = IIf(v, xlAutomatic, xlCalculationManual)
End With
End Sub

This made the macro run faster. Thank you!

Originally Posted by ByteMarks

Does it help if you disable calculation and screen updating?
NB: On Error Resume Next is ignoring any errors, not trapping them.

Sub ExtractTaxAnnualizationCopy()
DisableSettings (True)
If Sheets("EID_Tax Calculator").Range("C2").Value = 0 Then
    'Copy specific sheets only
    Worksheets(Array("Tax Annualization Copy", "13th Month Pay Copy", "EstimatedTaxableIncome Copy")).Copy
Else
    Worksheets(Array("Tax Annualization Copy", "YTD Copy", "Pivot YTD Static Copy", "13th Month Pay Copy", "EstimatedTaxableIncome Copy")).Copy
End If

'Remove workbook links
Dim ar As Variant
Dim i As Integer

On Error Resume Next 'IGNORE error

    ar = ActiveWorkbook.LinkSources(1)
    For i = 1 To UBound(ar) 'Excel VBA loop throuh links
    ActiveWorkbook.BreakLink ar(i), xlLinkTypeExcelLinks
    Next i

On Error GoTo 0
DisableSettings (False)
End Sub

Sub DisableSettings(v As Boolean)
v = Not v
With Application
    .ScreenUpdating = v
    .DisplayAlerts = v
    .Calculation = IIf(v, xlAutomatic, xlCalculationManual)
End With
End Sub

Big help, thank you!

You're welcome