How to copy and paste data, in lots of 200, from horizontal to vertical?

user_17522194 0
Viewed 127

I am trying to copy and paste data from horizontal to vertical from sheet1 to sheet3 in a lots of 200.

Say I have a list of 600 tickers. The code will copy the first 200 from sheet1 cells ("C6 till GT7") and paste it vertically in sheet3 cell A2.

I need the next lot of 200 appended in sheet3 after row 201.

My code is pasting only the last 200 in sheet 3.

enter image description here

enter image description here

Sub getbulkprices()
    Application.ScreenUpdating = False
    
    Dim wb As Workbook, ws, ws1 As Worksheet
    Dim r, iLastRow As Long, plr as long

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    Set ws1 = wb.Sheets("Sheet2")
    
    iLastRow = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
    ThisWorkbook.Sheets("Sheet1").Range("A2:A500").ClearContents
  
    ThisWorkbook.Sheets("Sheet3").Range("A2:B500000").ClearContents
     
    For r = 2 To ws1.Range("A" & Rows.Count).End(xlUp).Row Step 200
        ThisWorkbook.Sheets("Sheet1").Cells(2, 1).Resize(200).Value = _
          ws1.Cells(r, 1).Resize(200).Value
                  
        ws.Range("C1").FormulaR1C1 = "=@RHistory(R2C1:R200C1,"".Timestamp;.Close"",""NBROWS:""&R2C2&"" INTERVAL:1D"",,""SORT:ASC TSREPEAT:NO CH:In;"",R[5]C)"
        Application.Run "EikonRefreshWorksheet"
                
        Application.Wait (Now + TimeValue("0:00:02"))
               
        plr = ThisWorkbook.Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
               
        ws.Range("D6:IK7").Copy
               
        ThisWorkbook.Sheets("Sheet3").Range("A2:B" & plr + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=True
              
        Application.CutCopyMode = False
        Application.StatusBar = r & " / " & iLastRow - 1
    Next r
          
End Sub
vba excel
2 Answers

Consider qualifying the Rows.Count to the that same worksheet as qualifier to .Cells in the plr assignment:

plr = ThisWorkbook.Sheets("Sheet3").Cells( _
          ThisWorkbook.Sheets("Sheet3").Rows.Count, 1 _
      ).End(xlUp).Row

Even better situate the copy and paste inside a With block to avoid repetition of worksheet:

For r = 2 To ... Step 200
    ...

    With ThisWorkbook.Sheets("Sheet3")
        plr = .Cells(.Rows.Count, 1).End(xlUp).Row
    
        ws.Range("D6:IK7").Copy
               
        .Range(.Cells(plr + 1, 1), _ 
               .Cells(plr + 200, 2) _
        ).PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=True
   End With

   ...
Next r

Consider even WorksheetFunction.Transpose and avoid copy/paste:

With ThisWorkbook.Sheets("Sheet3")
    plr = .Cells(.Rows.Count, 1).End(xlUp).Row
          
    .Range(.Cells(plr + 1, 1), _ 
           .Cells(plr + 200, 2) _
    ) = WorksheetFunction.Transpose(ws.Range("D6:IK7"))
End With
user_14224510

Change the paste to ThisWorkbook.Sheets("sheet3").Range("A" & plr + 1 & ":B" & plr + 201).PasteSpecial...

user_167081070
Related