'How to copy and paste data, in lots of 200, from horizontal to vertical?
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.
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
Solution 1:[1]
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
Solution 2:[2]
Change the paste to
ThisWorkbook.Sheets("sheet3").Range("A" & plr + 1 & ":B" & plr + 201).PasteSpecial...
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
Solution | Source |
---|---|
Solution 1 | |
Solution 2 |