Fill an array LIKE a multiplication table with a macro

[tjakatjs]

Fair warning: This seems like a long winded explanation for a fairly simple macro.

I want to use a macro to complete an array that LOOKS LIKE a multiplication table but is not. Obviously, to complete a table like the one in the example would be simple enough to do with a formula copied to each cell but the worksheet I have uploaded is a gross oversimplification of the real thing. In the actual worksheet, the "product" in AE23 is a multilevel if/then, lookup statement that precludes simply filling the array with formulas. The process for filling it will be the same as in this simplified example using the ranges given in the example.

The x and y values may not always be the integers they are now but they would always have the same interval so I'm thinking it would be easier, rather than accessing the column/row in Sheet 2 each time to simply declare the value as an integer and add the given interval, in this case 1 and -1, to it in two separate loops, one to complete the first column and then move to the next column and complete it when there are no more values on the y axis. For example:

set x = Sheet 2:B1
set y = Sheet 2:A2

Loop one:
 Sheet 1:B22 = x 

Loop 2:


Do until column Sheet 2!A is blank:
Sheet1!B21 = y
Copy value of Sheet 1:B23 to appropriate cell in Sheet 2 (needs to move down one row with each loop 2 and over one for each loop 1)
Add 1 to y

end loop 2

Do until Sheet 2!Row 1 is empty
Add -1 to x





Using Record Macro to cycle through the second loop three times looks like this. 

 Sheet2!Range("B22").Select
    ActiveCell.FormulaR1C1 = "=Sheet2!R[-21]C"
    Range("B21").Select
    ActiveCell.FormulaR1C1 = "=Sheet2!R[-19]C[-1]"
    Range("B23").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("B21").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "2"
    Range("B23").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("B21").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "3"
    Range("B23").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False