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.