VBA – Copy Worksheet

Copying worksheet in VBA is actually a trivial task – use the macro recorder see the code and use it further. Anyway, if you are coding professionally with VBA (yup, we still exist:), you somehow get stomach problems, whenever you see .Activate and .Select in a production code. I even consider this as one of the top VBA errors.

Thus, the recording would not work. Then you can probably Google and you would see that mainly the first answers use those two. That’s bad, if you are thinking to get paid writing VBA.

Long story short, in order to save your stomach problems, this is the code I consider ok:

Public Sub CopyWorksheet(wksName As String)
    
    Dim newName As String
    newName = wksName & "_w"
    
    If WorksheetNameIsPresent(newName) Then
        Application.DisplayAlerts = False
        Worksheets(newName).Delete
        Application.DisplayAlerts = True
    End If
    
    Dim wks As Worksheet
    Dim newWks As Worksheet
    
    Set wks = Worksheets(wksName)
    wks.Copy after:=Worksheets(Worksheets.Count)
    Set newWks = Worksheets.Item(Worksheets.Count)
    
    With newWks
        .Name = newName
        .Tab.Color = vbBlue
    End With
    
End Sub

Public Function WorksheetNameIsPresent(newName As String) As Boolean

    Dim wks As Worksheet
    For Each wks In ThisWorkbook.Worksheets
        If wks.Name = newName Then
            WorksheetNameIsPresent = True
            Exit Function
        End If
    Next wks
    WorksheetNameIsPresent = False
    
End Function

Quite a bit of code, but still not bad. Furthermore, there is no check whether the worksheet from which we copy is present and this is on purpose. Usually I get this one from a collection of worksheet or something, thus the error would be handled correspondingly in the mother function.

If you want to copy 3-4 worksheets, this is a possibility:

Public Sub CopyWorksheets()

    Dim wksCollection As New Collection
    
    wksCollection.Add ThisWorkbook.Worksheets("VitoshAcademy")
    wksCollection.Add ThisWorkbook.Worksheets("Academy")
    wksCollection.Add ThisWorkbook.Worksheets("Vitosh")

    Dim wks As Worksheet
    Dim newWks As Worksheet

    For Each wks In wksCollection
        Dim newName As String
        newName = wks.Name & "_w"
    
        If WorksheetNameIsPresent(newName) Then
            Application.DisplayAlerts = False
            Worksheets(newName).Delete
            Application.DisplayAlerts = True
        End If
    
        wks.Copy after:=Worksheets(Worksheets.Count)
        Set newWks = Worksheets.Item(Worksheets.Count)
    
        With newWks
            .Name = newName
            .Tab.Color = 255
        End With
    Next wks

End Sub

I have even decided to add this one to my GitHub Boilerplate – if you want to change something, make a pull request! 🙂