Results 1 to 7 of 7

Thread: Copy Worksheet and Rename with Cell Value
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    May 2011
    Posts
    27
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Copy Worksheet and Rename with Cell Value

    I have a list of employees and I would like code to run on a button click that will copy a template sheet (Blank MAP) rename it from the emp list and continue to do this until it finds a blank cell.

    My code works sometimes but when it does it is really slow. There is other code needed to grab the emp name, emp id and paste them into specific cells as well but my focus is on the worksheet creation right now.

    Below is the code to create the sheets:

    Sub UpdateMAPs()
    Application.ScreenUpdating = False
    Dim i As Integer
    Dim ShName As String
    i = 2
    Do
    Sheets("Team List").Select
    ShName = Cells(i, 5).Value
    Sheets("Blank MAP").Select
    Sheets("Blank MAP").Copy Before:=Sheets("Blank MAP")
    Sheets("Blank MAP (2)").Name = ShName
    i = i + 1
    Loop Until IsEmpty(Cells(i, 5).Value)
    End Sub

    As you can tell I am fairly new to vba so the code might be sloppy.

  2. #2
    Legend VoG's Avatar
    Join Date
    Jun 2002
    Location
    127.0.0.1
    Posts
    63,651
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Copy Worksheet and Rename with Cell Value

    Try

    Code:
    Sub UpdateMAPs()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
    With Sheets("Team List")
        LR = .Range("E" & Rows.Count).End(xlUp).Row
        For i = 2 To LR
            Worksheets.Add(before:=Worksheets("Blank MAP")).Name = .Range("E" & i).Value
        Next i
    End With
    Application.ScreenUpdating = True
    End Sub
    HTH, Peter
    Please test any code on a copy of your workbook.

  3. #3
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    75,143
    Post Thanks / Like
    Mentioned
    60 Post(s)
    Tagged
    6 Thread(s)

    Default Re: Copy Worksheet and Rename with Cell Value

    Try this.
    Code:
    Option Explicit
     
    Sub UpdateMAPs()
    Dim wsMAP As Worksheet
    Dim wsNew As Worksheet
    Dim rng As Range
    Dim ShName As String
     
        Application.ScreenUpdating = False
     
        Set rng = Sheets("Team List").Range("E2")
     
        Set wsMAP = Sheets("Blank MAP")
     
        While rng.Value <> ""
    
            ShName = rng.Value
     
            wsMAP.Copy Before:=wsMAP
     
            Set wsNew = Sheets(wsMAP.Index - 1)
     
            wsNew.Name = ShName
     
            Set rng = rng.Offset(1)
    
        Wend
     
    End Sub
    If posting code please use code tags.

  4. #4
    New Member
    Join Date
    May 2011
    Posts
    27
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy Worksheet and Rename with Cell Value

    Quote Originally Posted by VoG View Post
    Try

    Code:
    Sub UpdateMAPs()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
    With Sheets("Team List")
        LR = .Range("E" & Rows.Count).End(xlUp).Row
        For i = 2 To LR
            Worksheets.Add(before:=Worksheets("Blank MAP")).Name = .Range("E" & i).Value
        Next i
    End With
    Application.ScreenUpdating = True
    End Sub
    Your code works beautifully to create the sheets, but I need them to be a copy of the Blank MAP sheet which it does not do.

  5. #5
    New Member
    Join Date
    May 2011
    Posts
    27
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy Worksheet and Rename with Cell Value

    Quote Originally Posted by Norie View Post
    Try this.
    Code:
    Option Explicit
     
    Sub UpdateMAPs()
    Dim wsMAP As Worksheet
    Dim wsNew As Worksheet
    Dim rng As Range
    Dim ShName As String
     
        Application.ScreenUpdating = False
     
        Set rng = Sheets("Team List").Range("E2")
     
        Set wsMAP = Sheets("Blank MAP")
     
        While rng.Value <> ""
     
            ShName = rng.Value
     
            wsMAP.Copy Before:=wsMAP
     
            Set wsNew = Sheets(wsMAP.Index - 1)
     
            wsNew.Name = ShName
     
            Set rng = rng.Offset(1)
     
        Wend
     
    End Sub
    Norie

    Your code just errors for me on line

    Code:
    wsMAP.Copy Before:=wsMAP

  6. #6
    Legend VoG's Avatar
    Join Date
    Jun 2002
    Location
    127.0.0.1
    Posts
    63,651
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Copy Worksheet and Rename with Cell Value

    Try

    Code:
    Sub UpdateMAPs()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
    With Sheets("Team List")
        LR = .Range("E" & Rows.Count).End(xlUp).Row
        For i = 2 To LR
            Sheets("Blank MAP").Copy Before:=Sheets("Blank MAP")
            ActiveSheet.Name = .Range("E" & i).Value
        Next i
    End With
    Application.ScreenUpdating = True
    End Sub
    HTH, Peter
    Please test any code on a copy of your workbook.

  7. #7
    New Member
    Join Date
    May 2011
    Posts
    27
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy Worksheet and Rename with Cell Value

    worked like a charm ... thank you =)

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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