Just set a shortcut key to run a macro like this one:
instructions : http://www.bettersolutions.com/word/...C216621011.htm


Sub LoopFillRange()
' Fill a range by looping through cells

Dim CellsDown As Long, CellsAcross As Long
Dim CurrRow As Long, CurrCol As Long

Dim CurrVal As Long

' Get the dimensions
CellsDown = 1
If CellsDown = 0 Then Exit Sub
CellsAcross = 7
If CellsAcross = 0 Then Exit Sub

'
' Loop through cells and insert values
CurrVal = 1
Application.ScreenUpdating = False
For CurrRow = 1 To CellsDown
For CurrCol = 1 To CellsAcross
Range("A1").Offset(CurrRow - 1, CurrCol - 1).Value = CurrVal
CurrVal = CurrVal + 1
Next CurrCol
Next CurrRow

' Display elapsed time
Application.ScreenUpdating = True

End Sub