Как поменять картинку (анимация на листе)

[dsapa]

Вот что у меня в конце концов получилось:
Sub Start()

Dim i As Integer, j As Integer, a As Long, x As New Collection, y As Range
With Sheets(2)
.Range(.Cells(1, 1), .Cells(100, 100)).ClearContents
ThisWorkbook.Sheets(2).Range("A1:CV 100").ClearContents
k = 0
For i = 1 To 100
For j = 1 To 100
If Sheets(2).Cells(i, j).Interior.ColorIndex <> Sheets(1).Cells(i, j).Interior.ColorIndex Then
k = k + 1
Sheets(2).Cells(i, j).Value = k
' l.Add k, CStr(k)
End If
Next
Next
For i = 1 To 100
For j = 1 To 100
If Sheets(2).Cells(i, j).Value > 0 Then
Metka: a = Int(Rnd() * k + 1)
On Error Resume Next
x.Add a, CStr(a)
If Err <> 0 Then
On Error GoTo 0
GoTo Metka
End If
.Cells(i, j) = a
End If
Next
Next
Set x = Nothing
For a = 1 To k
Set y = .Range(.Cells(1, 1), .Cells(100, 100)).Find(What:=a, LookAt:=xlWhole)
If Not y Is Nothing Then Sheets(1).Cells(y.Row, y.Column).Interior.ColorIndex = y.Interior.ColorIndex
Next
End With

End Sub