Trying to make this work for multiple cells - excel

Question

I have made this program that creates groups of 4 cells on sheets 2 and 3 depending on the value of a cell in sheet 1.
Sub Two_of_Two()
Dim Two_by_Two(1 To 6) As Range
Dim Diag1 As Range
Dim Diag2 As Range
Dim Horiz1 As Range
Dim Horiz2 As Range
Dim Vert1 As Range
Dim Vert2 As Range
Dim Share1 As Range
Dim Share2 As Range
Dim TopLeft As Range
Dim BottomRight As Range
Dim Black As Integer
Dim White As Integer
Black = 255
White = 0
Set Diag1 = Sheet1.Range("E17:F18")
Set Diag2 = Sheet1.Range("H17:I18")
Set Horiz1 = Sheet1.Range("E21:F22")
Set Horiz2 = Sheet1.Range("H21:I22")
Set Vert1 = Sheet1.Range("E24:F25")
Set Vert2 = Sheet1.Range("H24:I25")
Set Two_by_Two(1) = Diag1
Set Two_by_Two(2) = Diag2
Set Two_by_Two(3) = Horiz1
Set Two_by_Two(4) = Horiz2
Set Two_by_Two(5) = Vert1
Set Two_by_Two(6) = Vert2
Dim Cell As Range
Dim Subpixel As Range
For Each Cell In Sheet1.Range("A1")
Set Share1 = Sheet2.Range("A1:B2")
Set Share2 = Sheet3.Range("A1:B2")
Share1.Value = Two_by_Two(Int((6 - 1 + 1) * Rnd + 1)).Value
If Cell.Value >= 127.5 Then
Share2.Value = Share1.Value
ElseIf 127.5 > Cell.Value Then
For Each Subpixel In Share1
If Subpixel.Value = Black Then
Sheet3.Cells(Subpixel.Row, Subpixel.Column) = White
ElseIf Subpixel.Value = White Then
Sheet3.Cells(Subpixel.Row, Subpixel.Column) = Black
End If
Next Subpixel
End If
Next Cell
End Sub
I want to make it so that this works for multiple cells. Say once the for loop goes on to the next cell A2, it inputs values into the next 2x2 group of cells along. So if A1 in Sheet 1 corresponds to the range ("A1:B2") in Sheets 2 and 3, then B1 in Sheet 1 would be ("C1:D2") in Sheets 2 and 3.
Can someone please help me with this? Thanks.

Answer 1

I've cleaned up the code quite a bit and looped the Two_by_Two array.
Sub Two_of_Two()
Dim Two_by_Two(1 To 6) As Range
Dim Diag1 As Range: Set Diag1 = Sheet1.Range("E17:F18")
Dim Diag2 As Range: Set Diag2 = Sheet1.Range("H17:I18")
Dim Horiz1 As Range: Set Horiz1 = Sheet1.Range("E21:F22")
Dim Horiz2 As Range: Set Horiz2 = Sheet1.Range("H21:I22")
Dim Vert1 As Range: Set Vert1 = Sheet1.Range("E24:F25")
Dim Vert2 As Range: Set Vert2 = Sheet1.Range("H24:I25")
Dim Share1 As Range: Set Share1 = Sheet2.Range("A1:B2")
Dim Share2 As Range: Set Share2 = Sheet3.Range("A1:B2")
Dim TopLeft, BottomRight, Cell, Subpixel As Range
Dim Black, White, rndval As Integer
Dim i As Long
Black = 255
White = 0
Set Two_by_Two(1) = Diag1
Set Two_by_Two(2) = Diag2
Set Two_by_Two(3) = Horiz1
Set Two_by_Two(4) = Horiz2
Set Two_by_Two(5) = Vert1
Set Two_by_Two(6) = Vert2
rndval = Int(6 * Rnd + 1)
Share1.Value = Two_by_Two(rndval).Value
If Sheet1.Cells(1, 1) >= 127.5 Then
Share2.Value = Share1.Value
Else
Share2.Value = Sheet1.Cells(1, 1)
End If
For Each Subpixel In Share1
If Subpixel.Value = Black Then
Sheet3.Cells(Subpixel.Row, Subpixel.Column) = White
ElseIf Subpixel.Value = White Then
Sheet3.Cells(Subpixel.Row, Subpixel.Column) = Black
End If
Next Subpixel
End Sub