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:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
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:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
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! 🙂