Transfer data from template

Brutium

Board Regular
Joined
Mar 27, 2009
Messages
188
Hello,
I have a template which calculates in a certain column the averages of marks that students get on assignments. I have a macro which opens a number of sheets which are named according to the various tools for assessment that a teacher uses in class. All of the sheets use the same template. My question is: is there a way that I can collect all the averages calculated in the sheets that I opened (eventhough they use the same tamplate) on a sheet that I called "Overall"? I would need to set up the Overall sheet so that a teacher can add sheets and the marks get recorded on the Overall sheet without the user having to do any adjustment.
Any help would be greatly appreciated....
 
:) Good morning Jerry.

Thank you for your infinite patience.... I REALLY appreciate if.

I tried what you suggested but unfortunately I still get an error. This thine it says that I have a

Run-time error '9':
Subscript out of range

And once I run the Debug I get the following:

Sub Addsheets()
Dim LR As Long, i As Long, LastSheet As Long
With Sheets("tools")
LR = .Range("B" & Rows.Count).End(xlUp).Row
LastSheet = ActiveWorkbook.Sheets.Count
For i = 4 To LR
ActiveWorkbook.Sheets(LastSheet).Copy after:=Worksheets(i)
ActiveWorkbook.Sheets(i + 1).Name = .Range("B" & (i)).Value
Next i
ActiveWorkbook.Sheets(3).Name = .Range("B3").Value
End With
End Sub

:confused: I really think that I am lost...

Thanks again

Brutium
 
Upvote 0

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Hi Brutium,

This was my mistake. Since we are starting with i=4 now instead of i=3, we need to adjust the sheet references by one.

I mentioned earlier in the thread that when you reference the Sheets by Index, you run the risk that the Sheet doesn't exit...well I fell into that trap myself. :oops:

Rather than revise the indexes each time you change your range, I'll post some revised code shortly that makes the top row of your list a variable and adjusts everything else to it.
 
Upvote 0
This code should allow you to move your list more easily:

Code:
Sub Addsheets2()
    Dim LR As Long, i As Long, MasterSheet As Long
    Dim rngTopOfList As Range
 
    With Sheets("tools")
        Set rngTopOfList = .Range("B3")
        LR = .Cells(.Rows.Count, rngTopOfList.Column).End(xlUp).Row
 
        MasterSheet = ActiveWorkbook.Sheets.Count
        If LR > rngTopOfList.Row Then
            For i = 1 To LR - rngTopOfList.Row
                ActiveWorkbook.Sheets(MasterSheet).Copy _
                    after:=Worksheets(MasterSheet + i - 1)
                ActiveWorkbook.Sheets(MasterSheet + i).Name = _
                    rngTopOfList.Offset(i).Value
            Next i
        End If
        ActiveWorkbook.Sheets(MasterSheet).Name = rngTopOfList.Value
    End With
    Set rngTopOfList = Nothing
End Sub
 
Upvote 0
Hello Jerry,

Still no success.
Once I run the new macro it gives me a

Run-time error '1004':
Application-defined or object-defined error

and on Debug I get this:

Sub Addsheets()
Dim LR As Long, i As Long, MasterSheet As Long
Dim rngTopOfList As Range

With Sheets("tools")
Set rngTopOfList = .Range("B3")
LR = .Cells(.Rows.Count, rngTopOfList.Column).End(xlUp).Row

MasterSheet = ActiveWorkbook.Sheets.Count
If LR > rngTopOfList.Row Then
For i = 1 To LR - rngTopOfList.Row
ActiveWorkbook.Sheets(MasterSheet).Copy _
after:=Worksheets(MasterSheet + i - 1)
ActiveWorkbook.Sheets(MasterSheet + i).Name = _
rngTopOfList.Offset(i).Value
Next i
End If
ActiveWorkbook.Sheets(MasterSheet).Name = rngTopOfList.Value
End With
Set rngTopOfList = Nothing
End Sub


Please note that I changed the first line

from Sub Addsheets2() to Sub Addsheets()


Otherwise it would have given me an error that says the it cannot run the macro.


Also when I run the macro it does not rename my Mastersheet to the the first name in my list, but instead leaves it as Mastersheet and adds a Mastersheet (2) instead.

Brutium
 
Upvote 0
Let's break this down into two parts to isolate the problem: The copying of the sheets, and the renaming of the sheets.
Please comment out these two lines that do the renaming and see if the code sucessfully copies the correct number of Masters. If so, we'll debug the renaming.
Code:
' ActiveWorkbook.Sheets(MasterSheet + i).Name = _
'      rngTopOfList.Offset(i).Value
 
 
' ActiveWorkbook.Sheets(MasterSheet).Name = rngTopOfList.Value
 
Upvote 0
Sorry for my delayed response...I'm in and out of meetings today.

Next leave those two lines commented out and add this Debug.print statement
above the rename statement. This will allow you do see the progress in the Visual Basic Immediate Window.

Rich (BB code):
  Debug.Print "Rename Sheet: " & MasterSheet + i & _
               " Now: " & Worksheets(MasterSheet + i).Name & " to: " & _
                   rngTopOfList.Offset(i).Value
               ' ActiveWorkbook.Sheets(MasterSheet + i).Name = _
                   rngTopOfList.Offset(i).Value
I suggest paring down your list to just 4 names to make it easier to read...the problem will probably be the same whether you have 2 names or 200.

Let me know what displays in your Immediate Window.
 
Upvote 0
Hello Jerry,

Nothing happened. It just created the same 11 pages.
I had 3 names in my list in the Tools sheet. This is what I have as the script of my macro:

Sub Addsheets()
Dim LR As Long, i As Long, MasterSheet As Long
Dim rngTopOfList As Range

With Sheets("tools")
Set rngTopOfList = .Range("B3")
LR = .Cells(.Rows.Count, rngTopOfList.Column).End(xlUp).Row

MasterSheet = ActiveWorkbook.Sheets.Count
If LR > rngTopOfList.Row Then
For i = 1 To LR - rngTopOfList.Row
ActiveWorkbook.Sheets(MasterSheet).Copy _
after:=Worksheets(MasterSheet + i - 1)
Debug.Print "Rename Sheet: " & MasterSheet + i & _
" Now: " & Worksheets(MasterSheet + i).Name & " to: " & _
rngTopOfList.Offset(i).Value

' ActiveWorkbook.Sheets(MasterSheet + i).Name = _
' rngTopOfList.Offset(i).Value
Next i
End If
'ActiveWorkbook.Sheets(MasterSheet).Name = rngTopOfList.Value
End With
Set rngTopOfList = Nothing
End Sub

Brutium
 
Upvote 0
Brutium, I'm sure this must be frustrating but hang in there... :)

To view the Immediate Window:
Press the keys ALT + F11 to open the Visual Basic Editor
Press Ctrl + G to open the Immediate Window

When you run your macro, it will display some information that will help us zero in on the problem.

The fact that it is creating 11 pages instead of 3 might mean that the Last Range variable LR is reading that you have data from B3 to B12. The results that appear in the Immediate Window should make the problem clearer.
 
Upvote 0

Forum statistics

Threads
1,214,638
Messages
6,120,674
Members
448,977
Latest member
moonlight6

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top