Results 1 to 10 of 10

Thread: Grab data, create new sheet, rename tab, paste data

  1. #1
    Board Regular
    Join Date
    Sep 2006
    Posts
    154
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Question Grab data, create new sheet, rename tab, paste data

    Hi All

    I'm trying to speed up a process and in need to your help.

    I requested something similar a while back in an earlier post but can't adapt it.

    Here's what I do right now for each new tab.

    Sheet1 (Called Data) holds duplicate site names in Col A and staff names in Col B (sometimes duplicate)

    Sheet2 (Called Tracker) is setup as a template to hold the data from Data sheet.

    What I need:

    Remove duplicate name from Col B

    Copy Tracker sheet and put at the end.

    Copy the first site name from Col A and put into the new Tracker sheet at D5

    Check to see how many staff their are at that site and list them all in the new Tracker sheet from A11 downwards (paste value only).

    Rename the tab to the site name that was put in D5

    Repeat the process until there is a new tab for each site with a list of staff that work there.

    I will need to start this process from fresh each month so could use something that will remove all tabs expect the original two.

    Hope you can help.

    Terry
    Last edited by tezza; Jun 13th, 2019 at 09:37 AM.
    Office 2007 user.

  2. #2
    Board Regular
    Join Date
    Sep 2006
    Posts
    154
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    I've run through the process using the recorder so here it is in it's crudest form:

    Code:
    Sub Aberdare()
    '
    ' dryrun Macro
    '
    
    '
        Sheets("Tracker").Select                            'Select Tracker sheet
        Sheets("Tracker").Copy Before:=Sheets(3)            'Copy before sheet 3
        Range("D5:K5").Select                               'Select range in new sheet
        With Selection                                      'Select group of Cells
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False                              'Don't know if this is needed
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .mergecells = True
        End With
        Selection.UnMerge                                   'Unmerge them
        Sheets("Sheet1").Select                             'Select Sheet1
        ActiveSheet.Range("$A$1:$C$245").AutoFilter Field:=3, Criteria1:= _
            "Aberdare, 2015"                                'Filer dropdown list to first item
        Range("D2:D19").Select                              'Select Range
        Selection.Copy                                      'Copy it
        Sheets("Tracker (2)").Select                        'Select the New Sheet
        Range("A11").Select                                 'Select Cell A11
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False                       'Paste Values
        Sheets("Sheet1").Select                             'Select Sheet1
        Range("C2").Select                                  'Select Cell C2
        Application.CutCopyMode = False
        Selection.Copy                                      'Copy it
        Sheets("Tracker (2)").Select                        'Back to New sheet
        Range("D5").Select                                  'Select Cell D5
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False                       'Paste Valus
        Range("D5:K5").Select                               'Select D5:K5
        Application.CutCopyMode = False
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False                              'Still 'Don't know if this is needed
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .mergecells = False
        End With
        Selection.Merge                                     'Remerge the cells
        Sheets("Sheet1").Select                             'Select Sheet1
        ActiveSheet.Range("$A$1:$C$245").AutoFilter Field:=3 'Clear dropdown filter
    End Sub
    In a nutshell it's filtering out data from a drop down list that I have to manually select and copying it to specific cells in a newly duplicated sheet.

    It I only had to do it once this would be good enough but I have to do it many times, which I don't know how to setup so need help with that to go through the full drop down list automatically and place the data from the new list into a newly copied sheet.

    I've setup a little routine that renames the tabs to what's in D5, although it has issues if the name already exists.

    Please feel free to also streamline the code.

    Thank you
    Office 2007 user.

  3. #3
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,237
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    Can you post a screen shot of what your data looks like? Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-...forum-use.html Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  4. #4
    Board Regular
    Join Date
    Sep 2006
    Posts
    154
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    Ok, I'll give it a go:

    https://atalianworld-my.sharepoint.c...Yu0jw?e=1rGPff

    Sheet1 Holds the data

    Sheet2 is a template for each site to use

    Sheet3 is a filled in example of the first sites data in sheet1

    The idea is pretty basic, each site needs a list of names that belong to them which I'm trying to auto populate.

    Regards
    Office 2007 user.

  5. #5
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,012
    Post Thanks / Like
    Mentioned
    467 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    How about
    Code:
    Sub tezza()
       Dim Cl As Range
       Dim Dic As Object
       Dim Ky As Variant
       Dim Dws As Worksheet, Tws As Worksheet
       
       Set Dws = Sheets("Sheet1")
       Set Tws = Sheets("Tracker")
       Set Dic = CreateObject("scripting.dictionary")
       For Each Cl In Dws.Range("C2", Dws.Range("A" & Rows.Count).End(xlUp).Offset(, 2))
          If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, CreateObject("scripting.dictionary")
          Dic(Cl.Value)(Cl.Offset(, -1).Value) = Empty
       Next Cl
       For Each Ky In Dic.Keys
          Tws.Copy , Sheets(Sheets.Count)
          ActiveSheet.Name = Left(Ky, 31)
          Range("D5").Value = Ky
          Range("A11").Resize(Dic(Ky).Count).Value = Application.Transpose(Dic(Ky).Keys)
       Next Ky
    End Sub
    One of your store names is more than 31 characters, so I have just taken the first 31 characters for the sheet name
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  6. #6
    Board Regular
    Join Date
    Sep 2006
    Posts
    154
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    Thank you so much, works like a dream and you've done the tab names as well.

    You're a star
    Office 2007 user.

  7. #7
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,012
    Post Thanks / Like
    Mentioned
    467 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    You're welcome & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  8. #8
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,237
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    A slight modification to Fluff's code to delete all the sheets except the first two:
    Code:
    Sub tezza()
       Dim Cl As Range, Dic As Object, Ky As Variant, Dws As Worksheet, Tws As Worksheet, ws As Worksheet
       Set Dws = Sheets("Sheet1")
       Set Tws = Sheets("Tracker")
       Application.DisplayAlerts = False
        For Each ws In Sheets
            If ws.Name <> "Sheet1" And ws.Name <> "Tracker" Then
                ws.Delete
            End If
        Next ws
        Application.DisplayAlerts = True
       Set Dic = CreateObject("scripting.dictionary")
       For Each Cl In Dws.Range("C2", Dws.Range("A" & Rows.Count).End(xlUp).Offset(, 2))
          If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, CreateObject("scripting.dictionary")
          Dic(Cl.Value)(Cl.Offset(, -1).Value) = Empty
       Next Cl
       For Each Ky In Dic.Keys
          Tws.Copy , Sheets(Sheets.Count)
          ActiveSheet.Name = Left(Ky, 31)
          Range("D5").Value = Ky
          Range("A11").Resize(Dic(Ky).Count).Value = Application.Transpose(Dic(Ky).Keys)
       Next Ky
    End Sub
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  9. #9
    Board Regular
    Join Date
    Sep 2006
    Posts
    154
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    That's a nice finishing touch, thank you.
    Office 2007 user.

  10. #10
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,237
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Grab data, create new sheet, rename tab, paste data

    You're very welcome.
    Practice makes perfect. I'm very far from perfect so I'm still practising.

Some videos you may like

User Tag List

Tags for this Thread

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
  •