用于 A 列范围的 Excel vba 复制不同列的值

Question

I'm creating a new access database to import the data I manage in excel for the test results of several users.However the excel file I have due to the layout and the number of columns and files, is really hard to prepare the file for import manually. This is why I have been looking for any vba code to make the work :)

The file have in the column A the test references and then in each column it have the name of one user and the respective scores for each test. I need to copy for each user's name and all the test references and scores in consequent blocks so just using 3 columns, one for user's name, then test refence and finally the test score.

I think it is not so clear (but cannot explain better, sorry), so let me upload 2 pics of examples of current sheet data and how data should look after run the code.

Thanks so much in advance

Current sheet data

How data should look after run the code

Answer 1

Alright, this should be able to loop through like you're looking for. It's a little bit rigid because I don't really know much about your book layout. Right now, it assumes that Sheets(1) is the source and Sheets(2) is your destination.

Sub test()

    Dim lastCol As Long
    lastCol = Sheets(1).Cells(2, Columns.count).End(xlToLeft).Column

    Dim col As Long
    For col = 2 To lastCol
        userLoop (col)
    Next col

End Sub

Sub userLoop(ByVal col As Long)

    Dim lastRow_sheet1 As Long
    lastRow_sheet1 = Sheets(1).Cells(Rows.count, "A").End(xlUp).row

    Dim lastRow_sheet2 As Long
    lastRow_sheet2 = Sheets(2).Cells(Rows.count, "A").End(xlUp).row + 1
    If lastRow_sheet2 = 1 Then lastRow_sheet2 = 2

    Dim i As Long
    For i = 2 To lastRow_sheet1
        With Sheets(2)
            .Cells(lastRow_sheet2, "A").Value2 = Sheets(1).Cells(1, col).Value2
            .Cells(lastRow_sheet2, "B").Value2 = Sheets(1).Cells(i, "A").Value2
            .Cells(lastRow_sheet2, "C").Value2 = Sheets(1).Cells(i, col).Value2
        End With

        lastRow_sheet2 = lastRow_sheet2 + 1
    Next i

End Sub