Auch dieses Rätsel kann bei entsprechenden "Fachwissen" gut von Hand gelöst werden.
Allerding zeigen sich die Koordinaten dieses mal nicht auf den ersten Blick...
Viel Erfolg.
-----------------------
Sub Regular()
Dim x(33)
Columns("A:T").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ColumnWidth = 3.25
End With
Cells(1, 1).Select
For i = 1 To 8
Sheets(1).Copy Before:=Sheets(1)
Next i
Randomize
For Z = 1 To 20
For s = 1 To 20
Cells(Z, s) = Round(9 * Rnd())
Next s
Next Z
Aha = "tsvmcharlie liebt das Geocaching"
For y = 1 To 32
x(y) = Val(Right(Asc(Mid(Aha, y, 1)), 1))
Next
Cells(x(11), x(15)) = Chr(Val(x(4) & x(19)) - Val(x(23) & x(12)))
Cells(x(7) + x(4) + x(32), x(5) + x(20)) = x(5)
Cells(x(27), x(5) + x(2)) = x(6)
Cells(x(32) + x(3), x(10)) = x(18)
Cells(x(32), x(9)) = x(8)
Cells(x(14), x(29)) = x(27)
Cells(x(26) + x(14), x(6) + x(13)) = x(11)
Cells(x(28) + x(16), x(21) + x(1)) = x(31)
Sheets(x(1)).Name = " " & x(1) & " "
Sheets(x(2)).Name = " " & x(15) & " "
Sheets(x(3)).Name = " " & x(12) & " "
Sheets(x(4)).Name = " " & x(13)
Sheets(x(6)).Name = " " & x(28) & " "
Sheets(x(7)).Name = " " & x(22)
Sheets(x(11)).Name = Chr(Val(x(16) & x(12)) - Val(x(24) & x(32)))
Sheets(x(12)).Name = " " & " " & x(31) & " "
Sheets(x(32)).Name = " " & x(19) & " "
Sheets(x(22)).Cells(x(23), x(24)).Interior.ColorIndex = 6
Sheets(x(8)).Cells(x(21), x(6)).Interior.ColorIndex = 6
Sheets(x(20)).Cells(x(4) + x(30), x(29) + x(16)).Interior.ColorIndex = 6
Sheets(x(32)).Cells(x(32), x(3)).Interior.ColorIndex = 6
Sheets(x(14)).Cells(x(27), x(26) + x(2)).Interior.ColorIndex = 6
Sheets(x(28)).Cells(x(7) + x(5) + x(32), x(26) + x(20)).Interior.ColorIndex = 6
Sheets(x(13)).Cells(x(28) + x(16), x(30) + x(1)).Interior.ColorIndex = 6
Sheets(x(17)).Cells(x(32) + x(9), x(14)).Interior.ColorIndex = 6
Cells(22, 1).HorizontalAlignment = xlLeft
Cells(22, 1) = "Viel Spass beim Suchen der Dose..."
End Sub
-----------------------