Copying sheet based on items in a list.

[rakeshplb]

Hello all,

I have two sheets in a workbook, they are named as "List" and "Original"

I have a list of 'strings' (like apple, banana etc.) in a column A of the sheet called "List". The list has somewhere around 25 to 50 items.

I want -

1. To make copies of sheet "Original". One copy for each item on "List".
2. Each copy of sheet should be named based on the item name in list, leaving the first two characters of the string out - like for a string called apple, the sheet should be named as "ple", for "Banana" the sheet should be called as "nana" etc.
3. Cell "A2" of each should have the full "string", like "Apple", "Banana" etc.

So in the end result the workbook will have -

1. Sheet "List" unaltered.
2. Sheet "Original" unaltered.
3. Sheet "ple" - copy of "Original", cell A2 should have "Apple"
4. Sheet "nana" - copy of "Original", cell A2 should have "Banana" and so on...

Is this something possible? I have so far been able to make copies of "Original" based on count of items in the "List", do not know how to move forward.

Can some one give me those precious bits of code to make this happen?

Thank you so much!

 

[AnAnalyst]

Hi there,

Easy to do, but what row does your list in column A of the original sheet start on? Or is that not relevant?

 

[rakeshplb]

Hi there,

Easy to do, but what row does your list in column A of the original sheet start on? Or is that not relevant?

Thanks AnAnalyst.

It starts from cell A2 (A1 is header) on sheet "List". Sheet "Original" has dozen of columns and rows.

 

[AnAnalyst]

Hi there,

Try this:

Sub CopyOriginal()
    Dim rngList As Range
    Dim rngCell As Object
    Dim shtList As Worksheet
    Dim shtOriginal As Worksheet
    Dim shtCopy As Worksheet
    Dim strItem As String
    Dim strShortCode As String
    
    Set shtList = Sheets("List")
    Set shtOriginal = Sheets("Original")
    Set rngList = shtList.Range("A2:A" & shtList.Range("A" & Rows.Count).End(xlUp).Row)
    
    For Each rngCell In rngList.Cells
        strItem = rngCell.Value
        strShortCode = Mid(strItem, 3, 255)
        shtOriginal.Copy after:=Sheets(Sheets.Count)
        Set shtCopy = ActiveSheet
        With shtCopy
            .Name = strShortCode
            .[A2].Value = strItem
        End With
     
    Next rngCell
    
    Set shtList = Nothing
    Set shtOriginal = Nothing
    Set rngList = Nothing
    Set shtCopy = Nothing
    
End Sub

 

[rakeshplb]

Wonderful AnAnalyst!

You have helped me a big way. Saved me from one full night of efforts, each month.

Thank you so much.