Copy and Rename sheets via List Box

[Justplainj]

Hi All,

I have the following code which loops through a list box that contains all sheet name (the list box populates with a seperate vba which works fine.

Sub CopySheetsViaListBox()

Dim SheetName() As String
Dim i As Long, c As Long

'Gets the names from the selection on the ListBox.
    With ActiveSheet.ListBoxSh
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ReDim Preserve SheetName(c)
                SheetName(c) = .List(i)
                c = c + 1
            End If
        Next i
    End With

ActiveWorkbook.Sheets(SheetName()).Copy after:=ActiveSheet

End Sub

The code works perfectly and copies the sheets by placing a "(2)" after the sheets name, however, I want to rename the copied sheets to the original sheets name plus add in the word "Copy" after it
The idea is if there are 5 sheets named from Sheet1 to Sheet5, and in the list box sheet2 and sheet3 is selected to be copied, it must copy sheet2 and sheet3, but the newly copied sheets must be renamed to "Sheet2 Copy" and Sheet3 Copy"

I tried adding a loop through the newly copied sheets or adding copy function with SheetName().Name = SheetName() & " Copy" after the SheetName(c) = .List(i) row but i keep getting errors.


Any assistance will be appreciated.
J

 

[Fluff]

How about

Sub CopySheetsViaListBox()

Dim i As Long, c As Long

'Gets the names from the selection on the ListBox.
    With ActiveSheet.ListBoxSh
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Sheets(.List(i)).Copy
                ActiveSheet.Name = .List(i) & " Copy"
            End If
        Next i
    End With

End Sub

 

[Justplainj]

Hi Fluff

Thank you for the response.
The above code works but is for some reason removes the sheet that the list box is on and copies the sheets to new workbooks.

I have amended the code you provided to the following to refer it to the active workbook and after the copy to point to the active sheet to be renamed and it works now as i originally intended.

Thank you very much for your help.

Sub CopySheetsViaListBox()

Dim SheetName() As String
Dim i As Long, c As Long

'Gets the names from the selection on the ListBox.
    With ActiveSheet.ListBoxSh
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
            ReDim Preserve SheetName(c)
                ActiveWorkbook.Sheets(.List(i)).Copy after:=ActiveSheet
                ActiveSheet.Name = .List(i) & " Copy"
                SheetName(c) = .List(i)
                c = c + 1
            End If
        Next i
    End With