通过宏将列数据粘贴到Excel中一系列工作表中的特定位置

Question

嗨，我有一个问题需要解决。感谢有人可以帮我解决以下问题。

在Master Sheet我有类似的东西

Item        Price 1   Price 2    Price 3
Apple        12         25          30
Orange       20         12          13
Berry         5          6           3

然后在同一个excel doc上我说过Sheet1，Sheet2和Sheet3。我需要运行一个宏，这样一旦它运行3张将如下所示。当它被复制到一张纸上时，位置（单元格）应该是预先确定的位置。有人能给我一个线索吗？

Sheet 1中：

Apple
12
25
30

Sheet 2中：

Orange
20
12
13

表Sheet 3：

Berry
5
6
3

修改：此修改与 Alex P

的答案有关

 Item        Price 1   Price 2    Price 3
Apple        12                     30
Orange       20         12          13
Berry         5          6           3

在 Apple 下，价格2 没有价格。那么在打印时如何在工作表1中反映如下？换句话说，如果序列中有空白，则当数据被复制到选定的工作表时，应忽略空白单元格，以便数据处于序列中，而中间没有空单元格。

           **Apple**
Price 1       12
Price 3       30

而不是;

           **Apple**
Price 1       12
Price 2     (Blank cell)
Price 3       30

另外，我想将Price1,2,3 ...与上面显示的数字一起打印。

编辑2

如果表的位置如下，Alex的解决方案可以工作;

如果我将表格位置更改为以下内容，您能告诉我如何更改代码Set items = Range("A2:A" & Range("A1").End(xlDown).Row)以获得相同的结果。我一直在努力解决这个问题，但无法通过。我尝试将其更改为Set items = Range("C8:C" & Range("C7").End(xlDown).Row)，但在打印时对结果没有好处

Answer 1

我对此进行了测试，它对我有用。

您可能需要更改范围参考以满足您的需求。

Sub SplitTableData()
    Dim items As Range, item As Range, sht As Long

    Set items = Range("A2:A" & Range("A1").End(xlDown).Row)
    sht = 1

    For Each item In items

        With Worksheets("Sheet" & sht)
            .Range("A1") = item
            .Range("A2") = item.Offset(0, 1)
            .Range("A3") = item.Offset(0, 2)
            .Range("A4") = item.Offset(0, 3)
        End With

        sht = sht + 1
    Next item
End Sub

编辑：根据修改后的请求更新了代码

Sub SplitTableData()
    Dim items As Range, item As Range, sht As Long, col As Long, rw As Long

    Set items = Range("A2:A" & Range("A1").End(xlDown).Row)
    sht = 1
    rw = 2

    For Each item In items

        With Worksheets("Sheet" & sht)
            .Range("B1") = item

                For col = 2 To 4
                    If item.Offset(0, col - 1) <> vbNullString Then
                        .Range("A" & rw) = Cells(1, col)
                        .Range("B" & rw) = item.Offset(0, col - 1)
                        rw = rw + 1
                    End If
                Next col

        End With

        sht = sht + 1
        rw = 2
    Next item
End Sub