Add and add name

I offer you an alternative solution to VBA. Power Query

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "Get & Transform Data").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.

PHP Code: 

Option Explicit
Sub test()
Dim lr&, i&, k&, rng, t As String, s, arr(), key
Dim dic As Object
Set dic = CreateObject("Scripting.dictionary")
With Worksheets("sheet1")
lr = .Cells(Rows.Count, "B").End(xlUp).Row
rng = .Range("B2:G" & lr).Value
ReDim arr(1 To lr - 1, 1 To 7)
    For i = 1 To lr - 1
        t = rng(i, 2) & "|" & rng(i, 3) & "|" & rng(i, 4) & "|" & rng(i, 5) & "|" & rng(i, 6)
        If Not dic.exists(rng(i, 1)) Then
            dic.Add rng(i, 1), t
        Else
            s = Split(dic(rng(i, 1)), "|")
            t = (s(0) + rng(i, 2)) & "|" & (s(1) + rng(i, 3)) & "|" & (s(2) + rng(i, 4)) & "|" & _
                (s(3) + rng(i, 5)) & "|" & (s(4) + rng(i, 6))
            dic(rng(i, 1)) = t
        End If
    Next
End With
k = 0
For Each key In dic.keys
    k = k + 1
    arr(k, 2) = key
    arr(k, 1) = WorksheetFunction.VLookup(key, Worksheets("BD").Range("A2:B1000"), 2, 0)
    For i = 0 To 4
        arr(k, i + 3) = Split(dic(key), "|")(i)
    Next
Next
With Worksheets("sheet2")
    .Range("A2").Value = "Name"
    .Range("B2:G2").Value = Worksheets("sheet1").Range("B1:G1").Value
    .Range("A3").Resize(dic.Count, 7).Value = arr
End With
End Sub 


With:
lr = .Cells(Rows.Count, "B").End(xlUp).Row
it runs to the last row of column B, that contains student numbers
to not put the name, just remove these lines:

PHP Code: 

'arr(k, 1) = WorksheetFunction.VLookup(key, Worksheets("BD").Range("A2:B1000"), 2, 0)
' .Range("A2").Value = "Name" 


Thank you. What I wanted to know is if I need to put more cells to the right, column H, I. Attached photo. Thank you

Time.JPG

Now just copy up to column G on sheet2

Time2.JPG