How to copy 500 cell value in a loop and run it untill it reaches the last cell

Solution for How to copy 500 cell value in a loop and run it untill it reaches the last cell
is Given Below:

i am trying to build a vba program in which i have 3 worksheets : sheet 1, sheet2 and sheet3, i will input the data in sheet 2 (column A : column E) and i want to copy first 500 rics to be copied from sheet 2 (column B) in sheet 1 (column A) and what ever the result comes based on refinitv formula in sheet 1 (column D : column G) should get copied to sheet 3 , then again the macro should go to sheet 2 copy the next 500 rics then paste it in sheet 1 column A and what ever the result comes should get pasted in sheet 3, this process should run untill all the rics are covered in sheet 2. for example if sheet 2 has total of 1200 rics then the loop will run thrice (500 + 500+ 200 = 1200). the only help i need is in the for loop section rest i will try on my own.

rewriting the sequence for better understanding:
sheet 2 : i will input the data, the macro should should pick first 500 rics from column B and paste those in sheet 1 , column (A2)
then the eikon formula will fetch the result based on column A and macro should copy the result in sheet 3
then again the next 500 rics from sheet 2 gets picked and the same process should be followed.

Sub CAEvents()
Application.ScreenUpdating = False

    Dim wb As Workbook, ws As Worksheet, wsRic As Worksheet, ws1 As Worksheet
    Dim iLastRow As Long, r As Long, n As Long, i As Integer
    Dim ric As String

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    Set ws1 = wb.sheeets("Sheet2") ' as appropriate
    'n = ws.Range("B2").Value ' days
    
    ThisWorkbook.Sheets("Sheet1").Range("A2:E50000").ClearContents
    'ThisWorkbook.Sheets("Output").Cells.ClearContents
    'ThisWorkbook.Sheets("InsertSeveralSpots").Range("B6:F6").End(xlDown).clearcontent

    ' loop through rics in col I
    iLastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    If iLastRow >= 2 Then
        For r = 2 To iLastRow
            ric = ws.Cells(r, "I")
            ws.Range("A2").Value2 = ric
            
             ws.Range("C1").FormulaR1C1 = "[email protected](R2C1,"".Timestamp;.Close"",""NBROWS:""&R2C2&"" INTERVAL:1D"",,""SORT:ASC TSREPEAT:NO CH:In;fd"",R[5]C)"
            
            Application.Run "EikonRefreshWorksheet"
            
            Application.Wait (Now + TimeValue("0:00:02"))

enter image description here

enter image description here

Please, test the next code. It is not tested, not having a test file, but it should work. Please, send some feedback after testing it:

Sub Copy500Rows()
   Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lastR2 As Long, lastRA As Long
   Dim lastR3 As Long, lastR As Long, arr2, arrDG, i As Long, noIt As Long, lastNr As Long
   
   Set sh1 = Worksheets("Sheet1") 'use here your necessary sheet
   Set sh2 = Worksheets("Sheet2") 'use here your necessary sheet
   Set sh3 = Worksheets("Sheet3") 'use here your necessary sheet
   lastR2 = sh2.Range("B" & sh2.rows.count).End(xlUp).row 'last row of B:B in sheet2
   
   lastR = 500              'the slices to be used
   noIt = Int(lastR2 / lastR)  'number of necesssary iterations
   'calculate the reall necessary number of iterations and the last iteration number of rows
   If lastR2 / lastR > noIt Then
      If noIt > 0 Then
          lastNr = lastR2 - noIt * lastR
          noIt = noIt + 1
      Else
         lastR = lastR2: noIt = 1
      End If
   ElseIf lastR2 / lastR < noIt Then
      lastR = lastR2: noIt = 1
   End If
   sh1.Range("A2:A" & sh1.Range("A" & sh1.rows.count).End(xlUp).row).ClearContents
   sh3.Range("D2:G" & sh3.Range("D" & sh3.rows.count).End(xlUp).row).ClearContents
   'put the formula:
   sh1.Range("D2").FormulaR1C1 = "[email protected](R2C1,"".Timestamp;.Close"",""NBROWS:""&R2C2&"" INTERVAL:1D"",,""SORT:ASC TSREPEAT:NO CH:In;fd"",R[5]C)"
   For i = 1 To noIt
        arr2 = sh2.Range("B" & IIf(i = 1, 2, (lastR + 1) * (i - 1)) & ":B" & (lastR + 1) * i).value 'put the range in an array to make the code faster
        lastRA = sh1.Range("A" & sh1.rows.count).End(xlUp).row + 1 'last empty row of A:A in sheet1
        sh1.Range("A" & lastRA).Resize(UBound(arr2), 1).value = arr2 'drop the array content in the last empty row of sheet1
        
        sh1.Calculate   'calculate

        arrDG = sh1.Range("D2:G" & sh1.Range("D" & sh1.rows.count).End(xlUp).row).value   'put the range in an array
        lastR3 = sh3.Range("D" & sh3.rows.count).End(xlUp).row + 1                                         'last empty row of D:D in sheet3
        'drop the array content:
        sh3.Range("D" & lastR3).Resize(UBound(arrDG), UBound(arrDG, 2)).value = arrDG
        If i = noIt - 1 And lastNr > 0 Then lastR = lastNr
   Next i
   MsgBox "Ready..."
End Sub