Copy/Paste ActiveSheet and rename with Increment based on old name

[jo_hivera]

Good Afternoon everyone!

I need help a macro that increments correctly.
The macro i'm trying to tweak is meant to copy the activesheet, and paste the duplicate with the old name and the revision number.
i.e.: ORC01 to ORC01_R1

since this macro is applied to a button on the activesheet, it needs to be able to go from ORC01_R1 to ORC01_R2 (and so on) if the button is pressed again.
Right now the macro is looping incorrectly going from ORC01_R1 to ORC01_R1_R1 when the button is pressed again.

this is the code i'm trying to tweak.

Sub REVQT_Click()
Dim i As Long, wsName As String
 
  oldname = ActiveSheet.Name
  ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
   Do
    i = i + 1
    wsName = oldname & "_R" & i
    Loop While WorksheetExists(wsName)
  
    ActiveSheet.Name = wsName
    ActiveSheet.Range("V4").Value = i
ActiveSheet.Range("U4").Value = "Rev"

End Sub

Function WorksheetExists(wsName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Worksheets(wsName).Name = wsName
    On Error GoTo 0
End Function

Any suggestions are welcome.

 

[jo_hivera]

Nevermind i fixed it by changing the wsname formula

Sub REVQT_Click()
 Dim i As Long
 Dim ws As Worksheet
 Dim Year As String
 Year = DatePart("YYYY", Date)
 
 Set ws = ActiveSheet
  oldname = ActiveSheet.Name

With ws
    .Copy after:=Sheets(Sheets.Count)
    i = ActiveSheet.Range("V4").Value
    i = i + 1
    ActiveSheet.Name = "ORÇ" & ws.Range("U3") & "-" & Right(Year, 2) & "_R" & i
End With
 ActiveSheet.Range("v4").Value = i
End Sub