vba make row cells vertical and repeat value in column one - vba

Question

I have an Excel dataset that has animals in column a, and numbers in columns b, c, and d.
I would like to find a vba code that will take this dataset and do two things: transpose the numbers into a column, and then put the name of the associated animal into the adjacent cell. If you follow the link, sheet one shows the dataset that I have, and sheet 2 shows the dataset I would like to have.
you can see the dataset here: https://drive.google.com/file/d/0B8ss18LQyoQrdDVIQ2JMZmdPNVU/view?usp=sharing
This code will get me partway, but it doesn't do quite what I want it do to:
Sub moveandinsert()
Dim start_cell As Range
For i = 1 To 3
Set start_cell = Sheets("sheet1").Cells(i, 2)
Range(start_cell, start_cell.End(xlToRight)).Copy
Sheets("Sheet2").Select
lastRowA = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & lastRowA).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
For j = 1 To 12
If Cells(j, 1).Value > 0 Then
Sheets("Sheet1").Cells(i, 1).Copy
Sheets("Sheet2").Cells(j, 2).Select
Selection.PasteSpecial xlPasteAll
j = j + 1
End If
Next j
Next i
End Sub`
Any help will be appreciated

Answer 1

Try the following:
Sub moveandinsert()
Dim start_cell As Range
For i = 1 To 3
Set start_cell = Sheets("sheet1").Cells(i, 2)
Range(start_cell, start_cell.End(xlToRight)).Copy
Sheets("Sheet2").Select
lastRowA = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & lastRowA).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
For j = lastRowA To lastRowA + 4
If Cells(j, 1).Value > 0 Then
Sheets("Sheet1").Cells(i, 1).Copy
Sheets("Sheet2").Cells(j, 2).Select
Selection.PasteSpecial xlPasteAll
'j = j + 1
End If
Next j
Next i
End Sub
1) j = j + 1 is not required cuz j will increment itself in a for loop
2) you can use lastrowA as the starting point of your paste instead of hardcoded for j = 1 to 12