Paste Value from List into Separate Sheets

[ramkrau]

I need some help - google hasn't led me to anything useful

In my workbook, Sheet1 is a template used to analyze some data. Sheet2 is a list of values. My current macro asks a user how many times they need the template copied, and then copies Sheet1 as a new tab at the end of the workbook the requested number of times. I need to update this and do some more automation, but I just don't know how.

First, I want to automatically count the number of values in my list and use that count to tell my macro how many new tabs to create. Then, each new tab needs to have a value from the list copied and pasted into cell C3.

For example:
Sheet2's list in Column A might have 3 values:

Apple
Boat
Potato

I want the macro to count that there are three values, and then copy the first value paste into C3 in the first new tab, second value from the list and paste into C3 in the second new tab, third value from the list and paste into C3 in the third new tab.

So,
NewTab1.C3 = Apple
NewTab2.C3 = Boat
NewTab3.C3 = Potato

My current code isn't really powerful. Can anyone help me with some of this automation???? Pretty please?!?!?!?

Sub CopyConfigRequest()
Application.ScreenUpdating = False
Worksheets("Sheet1").Activate
Dim n As Integer
    On Error Resume Next
    n = InputBox("How many copies of the configuration request sheet do you want to make?")
 
    If n >= 1 Then
        For numtimes = 1 To n
            ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
        Next
    End If
Worksheets("Sheet2").Activate
Application.ScreenUpdating = True
Call wkstcolor
End Sub

 

[kweaver]

This is probably far from the best alternative, but I believe it works under your described conditions.

Sub CopyConfigRequest()
Application.ScreenUpdating = False
Worksheets("Sheet1").Activate
Dim n As Integer
    On Error Resume Next
    'n = InputBox("How many copies of the configuration request sheet do you want to make?")
    n = WorksheetFunction.CountA(Sheets("Sheet2").Range("A:A"))
    If n >= 1 Then
        For numtimes = 1 To n
            ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
            Sheets("Sheet1 " & "(" & (numtimes + 1) & ")").Range("C3") = Sheets("Sheet2").Range("A" & numtimes)
        Next
    End If
Worksheets("Sheet2").Activate
Application.ScreenUpdating = True
' Call wkstcolor
End Sub

 

[ramkrau]

This is probably far from the best alternative, but I believe it works under your described conditions.

Sub CopyConfigRequest()
Application.ScreenUpdating = False
Worksheets("Sheet1").Activate
Dim n As Integer
    On Error Resume Next
    'n = InputBox("How many copies of the configuration request sheet do you want to make?")
    n = WorksheetFunction.CountA(Sheets("Sheet2").Range("A:A"))
    If n >= 1 Then
        For numtimes = 1 To n
            ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
            Sheets("Sheet1 " & "(" & (numtimes + 1) & ")").Range("C3") = Sheets("Sheet2").Range("A" & numtimes)
        Next
    End If
Worksheets("Sheet2").Activate
Application.ScreenUpdating = True
' Call wkstcolor
End Sub

So, I gave this a shot and immediately found one correction I had to make...

    n = WorksheetFunction.CountA(Sheets("Sheet2").Range("A:A"))

had to become

    n = WorksheetFunction.CountA(Sheets("Sheet2").Range("A2:A200"))

so that it wouldn't count the header row in the worksheet. That's easy enough to fix...

But, the issue is that it still isn't doing the value paste that I really need...

In "Sheet2" cells A2:A200 represent a list of items... for example, if I have three things to list, they might be:

Apple
Boat
Potato

The goal is that after the macro counts that there are three things, and then creates the three new tabs, I would then like the for first new tab to pull the first item in my list (Apple) and paste that into cell C3 of that tab, the second new tab should pull the second item from the list (Boat) and past that into cell C3 of that tab, the third new tab to pull the third item from the list (Potato) and past that into C3 of that tab. That is the most important part of the script and the part that isn't working just yet.

I suspect it could be something with this line of your suggestion:

            Sheets("Sheet1 " & "(" & (numtimes + 1) & ")").Range("C3") = Sheets("Sheet2").Range("A" & numtimes)

because the behavior of the script doesn't change even if I comment that line out.

Any additional help would be SUPER appreciated!!!!!!!!!!!

 

[kweaver]

How about this modification?

Sub CopyConfigRequest()
Application.ScreenUpdating = False
Worksheets("Sheet1").Activate
Dim n As Integer
    On Error Resume Next
    'n = InputBox("How many copies of the configuration request sheet do you want to make?")
    n = WorksheetFunction.CountA(Sheets("Sheet2").Range("A2:A200"))
    If n >= 1 Then
        For numtimes = 1 To n
            ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
            Sheets("Sheet1 " & "(" & (numtimes + 1) & ")").Range("C3") = Sheets("Sheet2").Range("A" & numtimes + 1)
        Next
    End If
Worksheets("Sheet2").Activate
Application.ScreenUpdating = True
' Call wkstcolor
End Sub