How to copy and paste data from Horizontal to Vertical using vba-CodePudding

I am trying to copy and paste data from horizontal to vertical from sheet1 to sheet3 in a lot of 200, for say : i have a list of 600 tickers, what the code will do, it will copy first 200 tickers from sheet 1.cell("C6 till GT7") and paste it vertically in sheet3 cell A2, what i need is the next lot of 200 should get appended in sheet 3 after row 201 but what my current piece of code is only pasting the last 200 tickers in sheet 3.

 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

CodePudding user response：

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

CodePudding user response：

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:

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

    ws.Range("D6:IK7").Copy
               
    .Range("A2:B" & plr   1).PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=True
End With

Consider even WorksheetFunction.Transpose and avoid copy/paste:

With ThisWorkbook.Sheets("Sheet3")
    plr = .Cells(.Rows.Count, 1).End(xlUp).Row
          
    .Range("A2:B" & plr   1) = WorksheetFunction.Transpose(ws.Range("D6:IK7"))
End With