VBA to select named sheets and copy with new name

[Dunk4Divin]

Hi I am trying to select named sheets with a variable issue level the variable comes from a cell in each sheet.

Currently I have 5 sheets (could be any number) which all have the same name and issue level but are sheet numbered 1 to 5. The code should look for sheets with the sheet name and the current issue level which is taken from a cell in each sheet, then copy and rename with the next issue number. The new name and page number and issue level for the copy sheet all come from another cell in each sheet.

I have written the following code and tried a number of variations with varying levels of success but at the moment it is not doing anything! I think the way I am defining the name the sheets to look for is failing?

Sub UpIssueAllGRnR()

'Start loop to find named sheets

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets


'Define name for sheets to be duplicated (name start and current issue number)

If Left(ws.Name, 20) = "Gauge RnR Att Iss " & Cells(4, 16) Then

'Copy active sheet

ActiveSheet.Copy After:=Sheets(ActiveSheet.Index)

'Rename new sheet from defined cell (Same name and sheet number but with new issue level)

Dim NewNamex As String
NewNamex = ActiveSheet.Range("P14").Value
ActiveSheet.Name = NewNamex
End If
'Go to next defined sheet name

Next ws

End Sub


Any help would be greatly appreciated