Find named sheets according to current issue, copy and rename-CodePudding

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?

Pic shows current tab names and where the two cells are that the data comes form for the selection and re-name parts of the code

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

CodePudding user response：

Be careful: you are mixing implicit and explicit referencing of cells and worksheets.

I updated the code - but w/o test:

Sub UpIssueAllGRnR()

'Start loop to find named sheets

Dim ws As Worksheet
Dim NewNamex As String

For Each ws In ThisWorkbook.Worksheets
   '-->> ws won't get activated!!!

   'Define name for sheets to be duplicated (name start and current issue number)
   
   '-->> use ws wherever you reference cells from that sheet
   If Left(ws.Name, 20) = "Gauge RnR Att Iss " & ws.Cells(4, 16) Then

       'Copy sheet = ws
       ws.Copy After:=Thisworkbook.WorkSheets(ws.Index)

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

      NewNamex = ws.Range("P14").Value
      ws.Name = NewNamex
   End If
'Go to next defined sheet name
Next ws

End Sub

CodePudding user response：

The below code is tested and seems to be working in the environment I set up.

Sub UpIssueAllGRnR()

    Dim ws As Worksheet
    Dim currIndex As Integer


    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 " & Format(ws.Cells(4, 16).Value, "00") Then
    
            currIndex = ws.Index
        
            'Copy active sheet
            ws.Copy After:=ThisWorkbook.Sheets(currIndex)
        
           '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
            ThisWorkbook.Sheets(currIndex   1).Name = NewNamex
    
        End If
    

    Next ws

End Sub

CodePudding user response：

I haven't tested this code however I fixed a couple mistakes you made. Try using as much explicit code as you can. I also suggest that you use .Text instead of .Value to be sure to get a string.

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 " & ws.Cells(4, 16).Text Then
        'Copy active sheet
        ws.Copy After:=Sheets(ws.Index)
        
        'Rename new sheet from defined cell (Same name and sheet number but with new issue level)
        ActiveSheet.Name = ActiveSheet.Name & ActiveSheet.Range("P14").Text
    End If
    'Go to next defined sheet name
Next ws
End Sub