RIEMPIMENTO CELLE

Sub a()
Dim cont As Long, r As Long, c As Long

r = 1
c = 1
cont = 1

Application.ScreenUpdating = False

Do While r < 710

    
    Do While c < 850
       
        Cells(r, c).Value = cont
       
        cont = cont + 1
        
        If cont = 593776 Then
            
            ActiveWindow.ScrollRow = 690
            ActiveWindow.SmallScroll ToRight:=312
            Cells(r, c).Activate
            MsgBox "Finito!"
            Exit Sub
        End If
        
        c = c + 1
        
    Loop
    
    
r = r + 1
c = 1

Loop

Application.ScreenUpdating = True



End Sub