Use arrays to fill ranges faster
Sub ArrayFillRange() Dim TempArray() As Integer Dim TheRange As range CellsDown = 3 CellsAcross = 4 StartTime = timer ReDim TempArray(1 To CellsDown, 1 To CellsAcross) Set TheRange = ActiveCell.range(Cells(1, 1), Cells(CellsDown, CellsAcross)) CurrVal = 0 Application.ScreenUpdating = False For I = 1 To CellsDown For J = 1 To CellsAcross TempArray(I, J) = CurrVal + 1 CurrVal = CurrVal + 1 Next J Next I TheRange.value = TempArray Application.ScreenUpdating = True MsgBox Format(timer - StartTime, "00.00") & " seconds" End Sub