Results 1 to 2 of 2
  1. #1
    Star Lounger
    Join Date
    Jun 2002
    Location
    Johannesburg, Gauteng, South Africa
    Posts
    59
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Copy and Rename Sheets Excl 2007

    Hi once again, I hope someone can help. I have a workbook with a sheet named "0001". I wish to copy this sheet "x" times and incremently rename each sheet. For example, copy 4 times and have sheets named "0001"; "0002"; "0003"; "0004";"0005".

    The following code does part of the job in that it allows me to name the sheet to be copied and to provide the number of copies required and copies the sheet the correct number of times but gives them names "0001 (2)", "0001 (3)" etc.
    How should I modify the code?

    Dim Arr() As String
    Dim i As Integer
    ReDim Arr(Sheets.Count - 1)
    For i = 0 To Sheets.Count - 1
    Arr(i) = Sheets(i + 1).Name
    Next i


    SheetName = Application.InputBox("Enter the name of the sheet you wish to copy")
    NumCopies = Application.InputBox("Enter the number of times you wish to copy the sheet")


    Counter = 0
    MyNum = NumCopies
    Do Until MyNum = 0
    MyNum = MyNum - 1
    Counter = Counter + 1
    Sheets(SheetName).Select
    Sheets(SheetName).Copy After:=Sheets(Sheets.Count)

    Loop

    Thanks

    Raymond

  2. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Since your code asks for the sheet name, the assumption I have made is that 0001 is not always the copied sheet. The following code would make as many copies as you requested but relies on a few conditions which should probably be handled if you are using this regularly. Eg it will baulk if you don't provide a valid sheet name or already have a sheet which is called "0001", "0002" etc.
    Code:
    Sub DuplicateSheetz()
      Dim SheetName As String, NumCopies As Integer
      SheetName = Application.InputBox("Enter the name of the sheet you wish to copy")
      NumCopies = Application.InputBox("Enter the number of times you wish to copy the sheet")
      Do While NumCopies > 0
        Sheets(SheetName).Copy after:=Sheets(SheetName)
        Sheets(Sheets(SheetName).Index + 1).Name = Format(NumCopies, "0000")
        NumCopies = NumCopies - 1
      Loop
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  3. The Following User Says Thank You to Andrew Lockton For This Useful Post:

    Raymond (2012-03-22)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •