# 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"",RC)"

Application.Run "EikonRefreshWorksheet"

Application.Wait (Now + TimeValue("0:00:02"))
``````  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"",RC)"
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