Copy from one Sheet and Paste to Another

[ryguy7272]

Hello all! I got a little confused by switching back and forth between
pages. As a result, my macro is not doing what I want it to do.

My goal is to get the code to start in Cell A3 of a Sheet named ‘Stocks’ and
for each row get the date, then for each column get the stock symbol, then
get the stock price; repeat down and over for the entire used range. Below
is the code that I’m working with:

Sub PopulateMacro()

'Delete the sheet "TransposedSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("TransposedSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "TransposedSheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "TransposedSheet"

Sheets("Stock").Select

Dim ws As Worksheet
Dim dtAsOfDate As Date
Dim sTicker As String
Dim dPrice As Double
Set ws1 = Application.ActiveSheet
Set ws2 = Application.Sheets("TransposedSheet")

Dim LastCol As Long
Dim LastRow As Long

Dim nWriteRowIndex As Integer
nWriteRowIndex = 1
'Assume Row 3 is header
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(3, Columns.Count).End(xlToRight).Column

For i = 3 To LastRow
dtAsOfDate = ws1.Cells(i, 1)
For j = 2 To LastCol
sTicker = ws1.Cells(3, j)
dPrice = ws2.Cells(i, j)
ws2.Cells(nWriteRowIndex, 1) = dtAsOfDate
ws2.Cells(nWriteRowIndex, 2) = sTicker
ws2.Cells(nWriteRowIndex, 3) = dPrice
nWriteRowIndex = nWriteRowIndex + 1
Next
Next
End Sub

This was working fine before, when the data was all on one sheet. Now that
I’m trying to switch back and forth between a ‘Stock’ sheet and a
‘TransposedSheet’. The results I’m getting are all zeros.

Thanks for the help!
Ryan---.

 

[Jacob Skaria]

Hi Ryan

Going through your code few initial thoughts

--You dont need to select any sheets
Sheets("Stock").Select

Instead
Set ws1 = Basebook.Sheets("Stock")

and I assume that is the same as below specified in your code...
Set ws1 = Application.ActiveSheet



--In the below code specify the worksheet before Cells
LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
LastCol = ws1.Cells(3, Columns.Count).End(xlToRight).Column

 

[Jacob Skaria]

Taking a closer look there are few more errors..

--dPrice = ws2.Cells(i, j) should be ws1.Cells(i, j)

--If the header is in Row3 then you should be starting the loop from Row 4;
isnt it. Try adjusting that in the below macro. End of the code probably you
will have to format the date column and currency column....


Sub PopulateMacro()

Dim wb As Workbook, wsStock As Worksheet, wsTrans As Worksheet
Dim lngLastCol As Long, lngLastRow As Long
Dim lngRow As Long, lngCol As Long, lngNewRow As Long

Set wb = ThisWorkbook

'Delete the sheet "TransposedSheet" if it exist
Application.DisplayAlerts = False: On Error Resume Next
wb.Sheets("TransposedSheet").Delete
On Error GoTo 0: Application.DisplayAlerts = True

Set wsTrans = wb.Worksheets.Add
wsTrans.Name = "TransposedSheet"
Set wsStock = wb.Sheets("Stock")

'Assume Row 3 is header
lngLastRow = wsStock.Cells(Rows.Count, "A").End(xlUp).Row
lngLastCol = wsStock.Cells(3, Columns.Count).End(xlToLeft).Column

For lngRow = 4 To lngLastRow
For lngCol = 2 To lngLastCol
lngNewRow = lngNewRow + 1
wsTrans.Range("A" & lngNewRow).Value = wsStock.Cells(lngRow, 1)
wsTrans.Range("B" & lngNewRow).Value = wsStock.Cells(3, lngCol)
wsTrans.Range("C" & lngNewRow).Value = wsStock.Cells(lngRow, lngCol)
Next
Next

End Sub

 

[ryguy7272]

Thanks for the look Jacob. I made those recommended changes and now it
errors on this line:
dtAsOfDate = ws1.Cells(i, 1)

Error message is Run-Time error '13'
Type mismatch

It's telling me dtAsOfDate = 12:00:00AM
That's coming from a null, I guess on Sheet 'TransposedSheet'

Just looking at the bottom 2/3 of the code, I have this:
Dim ws As Worksheet
Dim dtAsOfDate As Date
Dim sTicker As String
Dim dPrice As Double
Set ws1 = Basebook.Sheets("Stock")
Set ws2 = Basebook.Sheets("TransposedSheet")

Dim LastCol As Long
Dim LastRow As Long

Dim nWriteRowIndex As Integer
nWriteRowIndex = 1
'Assume Row 3 is header
LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
LastCol = ws1.Cells(3, Columns.Count).End(xlToLeft).Column

For i = 3 To LastRow
dtAsOfDate = ws1.Cells(i, 1)
For j = 2 To LastCol
sTicker = ws1.Cells(3, j)
dPrice = ws2.Cells(i, j)
ws2.Cells(nWriteRowIndex, 1) = dtAsOfDate
ws2.Cells(nWriteRowIndex, 2) = sTicker
ws2.Cells(nWriteRowIndex, 3) = dPrice
nWriteRowIndex = nWriteRowIndex + 1
Next
Next

One more thing, I changed one line above:
LastCol = ws1.Cells(3, Columns.Count).End(xlToLeft).Column

This line is right now. Code still crashes, as described above.

 

[ryguy7272]

Perfect! Whatever they're paying you, it should be more!
Thanks!!
Ryan--