Code to copy the active WS before a specific WS in the WB

[ROBJ]

Hello there.
The following VBA code creates a new WS at the end of the WB. I need however to copy the current (active) sheet and be able to copy it before a specific sheet. What do I need to edit in the code to be able to copy?
And can the copy to the specific location be solved with a 2nd input box?

Thanking you in advance.
Rob



Public Sub AddSheet()
Dim shName As String
Dim shExists As Boolean

Do

shName = InputBox("Please Enter Seet Name")
If shName <> "" Then

shExists = SheetExists(shName)
If Not shExists Then

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = shName
Else

MsgBox "Worksheet " & shName & " already exists", vbOKOnly + vbInformation, "Add Sheet"
End If
End If
Loop Until Not shExists Or shName = ""
End Sub

Private Function SheetExists(ByVal SheetName As String, _
Optional ByVal wb As Workbook)

If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = Not wb.Worksheets(SheetName) Is Nothing

End Function

[Paul_Hossler]

Welcome to VBAX

You can use the [#] icon to insert CODE tags and then just paste any macro code between -- it sets off and also formats your macro

[Paul_Hossler]

Try something like this





Option Explicit

Public Sub AddSheet()
Dim shName1 As String, shName2 As String
Dim shOK1 As Boolean, shOK2 As Boolean
Dim wsOrig As Worksheet

Set wsOrig = ActiveSheet

shOK1 = False
Do
shName1 = InputBox("Please Enter Sheet Name for the Copy of the ActiveSheet ")
If Len(shName1) = 0 Then Exit Sub

If SheetExists(shName1) Then
msgbox "'" & shName1 & "' Already Exists"
Else
shOK1 = True
End If
Loop Until shOK1


shOK2 = False
Do
shName2 = InputBox("Please Enter Sheet Name To Copy '" & shName1 & "' After")
If Len(shName2) = 0 Then Exit Sub

If Not SheetExists(shName2) Then
msgbox "'" & shName2 & "' Does not Exist"
Else
shOK2 = True
End If
Loop Until shOK2

wsOrig.Copy After:=Worksheets(shName2)
ActiveSheet.Name = shName1

wsOrig.Select


End Sub

Private Function SheetExists(ByVal SheetName As String, Optional ByVal wb As Workbook)

If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = Not wb.Worksheets(SheetName) Is Nothing

End Function

[ROBJ]

Hi Paul.
Thank you so much.
It worked like a charm.