Need code help -- paste from multiple sheets to summary

[AngelK]

VB novice here. I am working on a code to pull one column of multiple sheets into a "summary" sheet. My workbook has sheets: summary, teacher, template, and 20-30 student sheets (varies). I need a code to copy each result (not blank cells) in column Q of each student sheet, and paste it under that student's column in the appropriate row on the Summary sheet.

My current code is able to pull the column Q from each student sheet, but it doesn't place it in the correct column in my summary (O7), and I it pulls in the entire column Q, even the blanks. The goal is to have the "grade" pulled into the matching question for each student.

Here is my current code:

Sub Create_Summary3() 
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long
Dim emptyColumn As Long

Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)

For i = 1 To Worksheets.Count - 3 'skips the non-student sheets
    
    Worksheets(i).Range("Q14:Q79").Copy
   sumSht.Cells(7, sumSht.Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlPasteValues
 
Next i

End Sub

here is a dropbox link for my file: https://www.dropbox.com/s/jin9dkuxu9...2).xlsm?dl=0

Thank you!

 

[AngelK]

Thank you jolivanes for still working with me. Using a downloaded copy from dropbox link in #4, with code in Module1, and Summary is my active sheet, neither codes will work for me. The above code #20 is also giving me an "object variable or with block variable not set" error on this line: MsgBox Sheets("Summary").Rows(6).Find(Trim(Split(Sheets(i).Name, ",")(0))).Column

What am I missing?

 

[jolivanes]

You are not missing anything. it is my bad. I know what the problem is but you'll have to sit tight until tomorrow. I am out of the door in a couple seconds.
Google for ".Find+LookIn:=xlValues" if you want to. That might give you an idea.
We'll have it fixed tomorrow

 

[jolivanes]

The previous problem was that I did not recognize that the names in Row 6 in the Summary sheet are the result of a formula.
Delete the previous code and try this one. It can be made more compact but this should be easier to change if required.

Sub Transfer()
    Dim AddressArr1, AddressArr2, i As Long, j As Long, a As String, b As Long
    AddressArr1 = Array("Q14", "Q19", "Q20", "Q25", "Q32", "Q38", "Q39", "Q42", "Q45", "Q48", "Q51", "Q54", _
    "Q59", "Q64", "Q67", "Q68", "Q71", "Q74", "Q75", "Q77", "Q78", "Q79")
    AddressArr2 = Array(7, 8, 9, 10, 11, 12, 13, 16, 17, 18, 19, 20, 23, 26, 27, 28, 31, 32, 33, 35, 36, 37)
    For i = 3 To ActiveWorkbook.Sheets.Count - 1
        For j = LBound(AddressArr2) To UBound(AddressArr2)
        
            a = Trim(Split(Sheets(i).Name, ",")(0))
            b = Sheets("Summary").Cells.Find(What:=a, After:=Cells(1, 1), LookIn:=xlValues, Lookat:=xlPart, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=xlFalse).Column
                
            Sheets("Summary").Cells(AddressArr2(j), b).Value = Sheets(i).Range(AddressArr1(j)).Value
            
        Next j
    Next i
End Sub

 

[AngelK]

It works for me!!! Thank you so much! You have turned a "Monday" into a great day!! I'm very thankful for your time on this!

 

[jolivanes]

My pleasure
Glad it all worked in the end.
Good luck and enjoy

 

[AngelK]

What an amazing code -- so helpful! I have a question if you don't mind ... When I use the code on my actual data, the code transfers all data for 30 students into my summary, but then I get a "Object variable or With block variable not set" on this:
b = Sheets("Summary").Cells.Find(What:=a, After:=Cells(1, 1), LookIn:=xlValues, Lookat:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=xlFalse).Column

Is it because it cannot find any more name matches? How do I resolve this?

Thank you, jolivanes!

 

[jolivanes]

How many sheets do you have between "Template" and "Summary"
The way your attachment is structured makes it a little more difficult because of the naming (sheet names versus names derived from a formula in row 6 in Summary.
I assume that if you have a sheet name but that name is not in row 6 in Summary you'll get an error like you described. Also, if the name is not spelled the same, it'll error.
If it works for now, fine. I'll see if I can come up with something for that error.

 

[jolivanes]

If you delete all the formulae in row 6 in Summary sheet from column O to the end column and run this code, you should be OK.
This code puts the student name in the cells in row 6. It also does away with a possible spelling difference and thus an error message popping up.
Of course everything else has to be as in the attachment.
It will also let you know if you have a difference in the amount of students in the "Teacher" sheet and student sheets.
Try it on a copy of your original and see if it is better.

Sub Transfer()
    If Sheets("Teacher").Cells(Rows.Count, 3).End(xlUp).Row - 1 <> ActiveWorkbook.Sheets.Count - 3 Then _
    MsgBox "There is a difference between the amount of students in column C and student sheets!" & vbLf & _
    "Please fix this problem before proceeding.": Exit Sub
    
    Dim AddressArr1, AddressArr2, i As Long, j As Long, a As String, b As Long
    
    AddressArr1 = Array("Q14", "Q19", "Q20", "Q25", "Q32", "Q38", "Q39", "Q42", "Q45", "Q48", "Q51", "Q54", _
    "Q59", "Q64", "Q67", "Q68", "Q71", "Q74", "Q75", "Q77", "Q78", "Q79")
    AddressArr2 = Array(7, 8, 9, 10, 11, 12, 13, 16, 17, 18, 19, 20, 23, 26, 27, 28, 31, 32, 33, 35, 36, 37)
    
    For i = 3 To ActiveWorkbook.Sheets.Count - 1
        a = Trim(Split(Sheets(i).Name, ",")(0))
        Sheets("Summary").Cells(6, i + 12).Value = a
        
        For j = LBound(AddressArr2) To UBound(AddressArr2)
            b = Sheets("Summary").Cells.Find(What:=a, After:=Cells(1, 1), LookIn:=xlValues, Lookat:=xlPart, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=xlFalse).Column
            Sheets("Summary").Cells(AddressArr2(j), b).Value = Sheets(i).Range(AddressArr1(j)).Value
        Next j
        
    Next i
End Sub

 

[AngelK]

Thank you for the great insight. Using your suggestion above, I was able to figure it out. I moved my Summary tab to 3rd tab, and adjusted the ActiveWorkbook.Sheets.Count from - 1 to -0, and it works great. I'm so thankful for your help!...again!

 

[jolivanes]

Re: and it works great.
Not for very long though.

If you move the Summary sheet after the "Teacher" and "Template" sheets, so it will be the 3rd sheet, you need to change this

For i = 3 To ActiveWorkbook.Sheets.Count - 1

to this

For i = 4 To ActiveWorkbook.Sheets.Count

After all, the first student sheet will be the 4th sheet.
If I was you, I would still go with the code I supplied a couple posts ago and change that one line if you indeed moved the Summary sheet.
It will do away with possible differences in name spellings.
If you do go this way and the Summary sheet will be the third sheet, you will also need to change this

Sheets("Summary").Cells(6, i + 12).Value = a

to this

Sheets("Summary").Cells(6, i + 11).Value = a