CODEWITHSUNDEEP
excelvba
user3574547
user3574547

Reputation: 99

Excel - Copy contents of a many cells to multiple worksheets based on the name of the activesheet

In Sheet1 there is, among other things, a list of students by Student ID and their Grade Level. In the Workbook there is also a separate Worksheet for each student. The Worksheets are named according to the Student ID. I need to copy the Grade Level for each student to their specific Worksheet. This must be done for all students.

For example Column AA contains the Student ID's, Column AB contains the Grade Levels for each student. I need to copy Student 12345, Grade 4 to Worksheet 12345 Cell F1. Then I need to move to the next student and do the same thing until I have no more students.

I have tried many methods, but I keep getting stuck. I've found examples that are close, but always miss one key thing to make it work so I'm hoping someone will be able to get me started. I feel it should be easy, but it hasn't proven to be.

Edit:

I was looking at trying to figure it out in steps. On a simple test file I tried: 

Dim I As Long 
For I = 1 To Sheets.Count
Worksheets(I).Activate 
Workbooks("StuData.xlsm").Sheets(I).Range("F1").Value = Workbooks("StuData.xlsm").Sheets("Sheet1").Cells(I, 2)
Next

Then I tried: 

Dim Sheetname as String 
Sub activateSheet(sheetname As String) 
    Worksheets(sheetname).Activate
End Sub

Upvotes: 2

Views: 441

Answers (2)

L42
L42

Reputation: 19737

Although I agree that what you want can be done without VBA, you can still try this:

Sub TransferGrades()
    Dim RID As Range, SID As Range, lrow As Long
    With Sheets("Sheet1") '~~> change to suit
        lrow = .Range("AA" & .Rows.Count).End(xlUp).Row
        Set RID = .Range("AA1", "AA" & lrow) '~~> change to suit
    End With
    For Each SID In RID
        On Error Resume Next
        '~~> You need to use CStr Function if ID's are numbers
        Sheets(CStr(SID.Value)).Range("F1").Value = SID.Offset(0, 1).Value
        If Err.Number <> 0 Then SID.AddComment "Not found,you need to add sheet." _
        Else SID.ClearComments
        On Error GoTo 0
    Next
End Sub

This will transfer grades to student ID sheets found only.
If the Student ID sheet is not found, it will be ignored and proceed with the next ID.
It will add comment on Student ID's that doesn't have it's corresponding Sheet. HTH.

Upvotes: 1

Rick
Rick

Reputation: 45281

You don't need VBA to do this.

First create the following Named Formula (Ctrl+F3->New) with SheetName in the Name: field scoped to the workbook. Enter the following exactly as it is below in Refers to: and click OK:

=RIGHT(CELL("FILENAME",!$A$1),LEN(CELL("FILENAME",!$A$1))-FIND("]",CELL("FILENAME",!$A$1),1))

Be sure to include the extra ! at the beginning of each cell address! Very important. Quick explanation: although is it scoped to the entire workbook, the ! at the beginning of the cell addresses makes each cell address in the named formula be evaluated in the context of the current worksheet. It is equivalent to having a different Sheetname variable for each worksheet (scoped to each worksheet).

Now select the first student sheet. Press Ctrl+Shift+PgDn and repeat, or simply hold Ctrl and click each individual student sheet, until all the student sheets are selected. You are now editing all of the student sheets at the same time.

In cell F1 of one of the student sheets (doesn't matter which), enter the following:

=INDEX('ALL STUDENTS SHEET'!$AB:$AB,MATCH(VALUE(SheetName),'ALL STUDENTS SHEET'!$AA:$AA,0))

(Of course you'll need to replace ALL STUDENTS SHEET with the name of the first sheet.)

Finally, deselect the multiple sheets by selecting the first sheet so you can continue working without editing all the sheets at the same time.

EDIT: Note that in order for SheetName to work as expected, the workbook must have been saved to disk (i.e. it will not work on a new workbook until it is saved since the CELL("FILENAME",<Cell Address>) formula needs a filename).

Upvotes: 1

Related Questions