vba使行单元格垂直并重复第一列中的值

Question

我有一个Excel数据集，其中列a中有动物，列b，c和d中有数字。

我想找到一个vba代码，它将采用这个数据集并做两件事：将数字转换为列，然后将相关动物的名称放入相邻单元格中。如果您按照链接进行操作，工作表一显示我有的数据集，工作表2显示我想要的数据集。

，你可以在这里看到的数据集：https://drive.google.com/file/d/0B8ss18LQyoQrdDVIQ2JMZmdPNVU/view?usp=sharing

此代码将让我中途，但它不会做完全是我想要做的：

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` 

任何帮助将不胜感激

Answer 1

尝试以下方法：

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并不需要d cuz j会自动增加一个for循环
2）您可以使用lastrowA作为粘贴的起点而不是硬编码为j = 1到12