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!

 

[Michael M]

Also check the column header names don't have leading / trailling spaces....they must replicate the sheet name exactly

 

[jolivanes]

@Michael
I just downloaded the attachment and it is not near what was described in Post#1 to my way of thinking.
The names you are referring to are the result of a formula.
I have to go out so I won't be able to do anything for today.
Have a good day though

 

[jolivanes]

Try this on a copy of your Workbook.
This should work on a Workbook as in Post#4

Sub Transfer()
    Dim AddressArr1, AddressArr2, i As Long, j 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)
            Sheets("Summary").Cells(AddressArr2(j), Sheets("Summary").Rows(6).Find(Trim(Split(Sheets(i).Name, ",")(0))).Column).Value = _
            Sheets(i).Range(AddressArr1(j)).Value
        Next j
    Next i
End Sub

 

[AngelK]

Thank you -- I did find a type mismatch between the column headers and the sheet names, fixed.
Now I'm getting error "That command cannot be used on multiple selections" on this line:

.Range("Q1:Q" & .Cells(.Rows.Count, "Q").End(xlUp).Row).SpecialCells(2).Copy

I tried to research online, but it doesn't make sense to me. So sorry for taking your time.
Thank you!!!

 

[jolivanes]

Did you see Post #13?
Undo the changes in Header / Sheet Name. The Sheet Name has to be like in Post #4 attachment and the Header has to be the same text as before the Full Stop(.) in the Sheet Name.
If everything is as in the attachment from Post #4, the code from Post #13 should work.
If you are going to change all the Sheet Names or the Headers, the code needs to be changed to reflect these changes.

This is from the code before we knew what your actual Sheet layout was.

.Range("Q1:Q" & .Cells(.Rows.Count, "Q").End(xlUp).Row).SpecialCells(2).Copy

Forget about that code.

 

[AngelK]

I had not seen #13. Will work on that. Not sure why it didn't come through for me this morning. Thank you for the help.

 

[AngelK]

Try this on a copy of your Workbook.
This should work on a Workbook as in Post#4

Sub Transfer()
    Dim AddressArr1, AddressArr2, i As Long, j 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)
            Sheets("Summary").Cells(AddressArr2(j), Sheets("Summary").Rows(6).Find(Trim(Split(Sheets(i).Name, ",")(0))).Column).Value = _
            Sheets(i).Range(AddressArr1(j)).Value
        Next j
    Next i
End Sub

Returned to the exact workbook as posted in #4. Sheet names are "smith1, joe1" (as before), header names are smith1 (as before). When I ran the code above, get a "object variable or with block variable not set" on this:
Sheets("Summary").Cells(AddressArr2(j), Sheets("Summary").Rows(6).Find(Trim(Split(Sheets(i).name, ",")(0))).Column).Value = _
Sheets(i).Range(AddressArr1(j)).Value

So sorry.

 

[jolivanes]

Please don't quote every post. Too much clutter

Re: Returned to the exact workbook as posted in #4

Save the workbook from your Drop Box in Post 4 and try the code on that.

 

[AngelK]

I saved the workbook from dropbox, post#4, and tried your "Transfer" code, and I get "object variable or with block variable not set" here:

Sheets("Summary").Cells(AddressArr2(j), Sheets("Summary").Rows(6).Find(Trim(Split(Sheets(i).name, ",")(0))).Column).Value = _
Sheets(i).Range(AddressArr1(j)).Value

I apologize if it's a step or something I'm missing somewhere. I'm trying~

 

[jolivanes]

Offhand I wouldn't know but it usually is because Find can't find what it should find. That's why I asked you to try on the attachment from Post #4. That workbook works like a charm for me.
You copied the code into a regular Module I assume.
Just run this macro when "Summary" sheet is your active sheet and see if it gives you the right column numbers.
The first one(smith1) should be should be 15 (=column O), the second 16 etc etc

Sub What_Columns()

    Dim i As Long
    For i = 3 To ActiveWorkbook.Sheets.Count - 1
        MsgBox Sheets("Summary").Rows(6).Find(Trim(Split(Sheets(i).Name, ",")(0))).Column
    Next i
End Sub