Copy and Rename Sheet based on cell data

[Revanancer]

I have data in A7-A26 and B7-B27. Column A is the new name for the sheet and column B is the sheet to copy. I would like to make a Macro that looks at the column B range, if there is the name of a sheet it makes a copy of it and renames it to the name in column A.

 

[DanteAmor]

Hi and welcome to MrExcel

In this line fit with the name of sheet with sheet names
Set sh1 = Sheets("Sheet1")

Sub copysheets()
  Dim sh1 As Worksheet
  Dim c As Range
  
  Set sh1 = Sheets("Sheet1")    'fit with the name of sheet with sheet names
  
  For Each c In sh1.Range("B7:B27")
    If c.Value <> "" And c.Offset(0, -1).Value <> "" Then
      If Evaluate("ISREF('" & c.Value & "'!A1)") Then
        If Not Evaluate("ISREF('" & c.Offset(0, -1).Value & "'!A1)") Then
          Sheets(c.Value).Copy after:=Sheets(Sheets.Count)
          ActiveSheet.Name = c.Offset(0, -1).Value
        End If
      End If
    End If
  Next
End Sub

 

[Revanancer]

Thank you, That Works perfectly, and much simpler than what I was trying to do.

One more thing, I would like to have the sheets hidden and only show the new copied sheets. Is this possible?

 

[DanteAmor]

Try:

Sub copysheets()
  Dim sh1 As Worksheet
  Dim c As Range
  
  Set sh1 = Sheets("Sheet1")    'fit with the name of sheet with sheet names
  
  For Each c In sh1.Range("B7:B27")
    If c.Value <> "" And c.Offset(0, -1).Value <> "" Then
      If Evaluate("ISREF('" & c.Value & "'!A1)") Then
        If Not Evaluate("ISREF('" & c.Offset(0, -1).Value & "'!A1)") Then
          Sheets(c.Value).Copy after:=Sheets(Sheets.Count)
          Sheets(Sheets.Count).Visible = True
          Sheets(Sheets.Count).Name = c.Offset(0, -1).Value
        End If
      End If
    End If
  Next
End Sub

 

[Revanancer]

Thank you

 

[Revanancer]

I have run into a small bug. The first sheet that is copied will remain hidden and the last hidden sheet will unhide and have its name changed.
so if the hidden sheets are in brackets it will look like this

Before Macro
S1 (S2, S3, S4, S5)

After Maco CS=Copied Sheet
S1 (S2(2), S2, S3, S4) CS1, CS2, CS3
SC1 was S5 and was renamed

 

[DanteAmor]

Try:

ub copysheets()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim c As Range
  Dim i As Long, n As Long
  Application.ScreenUpdating = True

  Set sh1 = Sheets("Sheet1")    'fit with the name of sheet with sheet names
  
  n = Sheets.Count
  ReDim b(1 To n, 1 To 2)
  For i = 1 To n
    b(i, 1) = Sheets(i).Name
    b(i, 2) = Sheets(i).Visible
    Sheets(i).Visible = -1
  Next
  
  For Each c In sh1.Range("B7:B27")
    If c.Value <> "" And c.Offset(0, -1).Value <> "" Then
      If Evaluate("ISREF('" & c.Value & "'!A1)") Then
        If Not Evaluate("ISREF('" & c.Offset(0, -1).Value & "'!A1)") Then
          Sheets(c.Value).Copy after:=Sheets(Sheets.Count)
          ActiveSheet.Name = c.Offset(0, -1).Value
        End If
      End If
    End If
  Next

  For i = 1 To n
    Sheets(b(i, 1)).Visible = b(i, 2)
  Next
  
  Application.ScreenUpdating = True
End Sub