Copy data from another worksheet based on cell values

Question

I am unsure of how to use VBA and would like to seek help with what I am trying to achieve using VBA on excel.

• The goal of the macro would be to copy a column of data "B" from worksheet (i.e "Questions Selected") and paste it into a fixed column "A" in another worksheet (i.e "Test Paper").

• The values pasted would then be matched to another worksheet (i.e "Chapter 1") and if the cell in "test paper" contains a value that matches another cell in column "A" of "Chapter 1" then it would copy that specific row of data from "Chapter 1" into "Test Paper"

• And for the macro to repeat itself from the 1st step from column "C" onward, pasting the values in the next available blank cell in column "A" of "Test Paper"

My current code is as follows:

Sub Test()

'

Set Source = Sheets("Questions Selected")
Worksheets.Add(After:=Worksheets("Main Page")).Name = "Test Paper" 'Adds a Sheet called "Test Paper"
Dim rng As Range
Set Destination = Sheets("Test Paper")
Source.Select
Set rng = Range("B2:B" & Source.Cells(Source.Rows.Count, "B").End(xlUp).Row)
With rng
    .Copy
Destination.Columns(1).PasteSpecial xlPasteValues
End With
End Sub

I don't understand how to continue with my VBA and the current coding only allows me to achieve my first step.

Appreciate all the help I can get.

Answer 1

Try this approach. It should get you what you are looking for. NOT TESTED:
These concepts of looping and checking single cells can be applied to many different situations. Strategically placed loops inside other loops, using Row numbers and Column numbers as counters and taking advantage of the .Cells(row,col) format.

Private Sub TableCheck()

Dim lastQsRow           'Last Row on Questions Selected
Dim lastQCol As Long    'Last Column on Questions Selected
Dim qColNum As Long     'Questions Selected Column Number

Dim lastTestRow As Long 'Last Test Paper Row
Dim tempRow As Long     'tempRow to keep track of place on Test Paper between loops
Dim testRow As Long     'Editing row on Test paper

Dim chapNum As Long     'Chapter Number for the Sheet Name
Dim lastChCol As Long   'Last Chapter Column
Dim lastChRow As Long   'Last Chapter Row
Dim chRow As Long       'Chaper Row
Dim chColNum As Long    'Chapter Column Number for copying entire row Loop.

'Set the Last Column on "Questions Selected"
lastQCol = Sheets("Questions Selected").Cells(1, Columns.Count).End(xlToLeft).Column
testRow = 2  'Set Row of "Test Paper" to 2 or whatever your first Non-Header Row is.

'-----PHASE ONE - COPY COLUMNS FROM "QUESTIONS SELECTED" TO "TEST PAPER" ----- BIG LOOP
For qColNum = 2 To lastQCol  'Begin Column Loop at column 2("B")
    tempRow = testRow
    lastQsRow = Sheets("Questions Selected").Cells(Rows.Count, qColNum).End(xlUp).Row
    'Get the Last Row of Column
    For qsRow = 2 To lastQsRow 'Loop from first NON-Header Row to the Last Row) on "Questions Selected"
        Sheets("Test Paper").Cells(testRow, "A").Value = Sheets("Questions Selected").Cells(qsRow, qColNum).Value
        testRow = testRow + 1
    Next qsRow

    '----PHASE TWO - COMPARE EACH ROW OF "TEST PAPER" TO "CHAPTERs" AND COPY MATCHING ROWS ---- INNER LOOP
    chapNum = 1
    'Get Last Row of "Chapter" & "Test Paper"
    lastChRow = Sheets("Chapter " & chapNum).Cells(Rows.Count, "A").End(xlUp).Row
    lastTestRow = Sheets("Test Paper").Cells(Rows.Count, "A").End(xlUp).Row

    'Loop through "Test Paper"
    For testRow = tempRow To lastTestRow
        'Loop through "Chapter"
        For chRow = 2 To lastChRow
            'Compare Value of Current Row on "Test Paper" to "Chapter"
            If Sheets("Test Paper").Cells(testRow, "A").Value = Sheets("Chapter " & chapNum).Cells(chRow, "A").Value Then
                lastChCol = Sheets("Chapter " & chapNum).Cells(chRow, Columns.Count).End(xlToLeft).Column
                'If Matching, copy every column from "Chapter" to "Test Paper"
                For chColNum = 2 To lastChCol
                    Sheets("Test Paper").Cells(testRow, chColNum).Value = Sheets("Chapter " & chapNum).Cells(chRow, chColNum).Value
                Next chColNum
            End If
        Next chRow
    Next testRow

    chapNum = chapNum + 1

Next qColNum

End Sub