如何复制和粘贴数据从水平到垂直？
我的原始电子表格中的数据是水平列出的。 例如：
ABCDEFG
1 A a 2 3 4 5 6
2 B b 1 3 4 5 6
3 C c 1 2 4 6 7
我想以垂直方式安排这张桌子。 如下所示：
ABC
1个 A 2
2一个3
3一个4
4 A 5
5一个6
6 B b 1
7 B b 3
。
。
。 我想出了如何find最后一行来粘贴值
Range("A1").End(xlDown).Offset(1,0) 而且我被堆积在如何做适当的循环来find每个数字，并相应地垂直粘贴，也与列A和B相匹配。
提前致谢。
尝试这个
Sub ArrangeVertical() Dim MyWorkbook As Workbook Dim Sheet1 As Worksheet Dim Sheet2 As Worksheet Dim myRow As Long Dim rowPointer As Long Dim columnPointer As Long Dim lastColumn As Long Dim LastRow As Long Set MyWorkbook = Workbooks(ActiveWorkbook.Name) Set Sheet1 = MyWorkbook.Worksheets("SaleTeam3") Set Sheet2 = MyWorkbook.Worksheets("SaleTeam4") myRow = 1 LastRow = Sheet1.Cells(Rows.Count, "a").End(xlUp).Row For rowPointer = 1 To LastRow lastColumn = Sheet1.Cells(rowPointer, Columns.Count).End(xlToLeft).Column For columnPointer = 3 To lastColumn Sheet2.Cells(myRow, 1).Value = Sheet1.Cells(rowPointer, 1).Value Sheet2.Cells(myRow, 2).Value = Sheet1.Cells(rowPointer, 2).Value Sheet2.Cells(myRow, 3).Value = Sheet1.Cells(rowPointer, columnPointer).Value myRow = myRow + 1 Next columnPointer Next rowPointer End Sub
你真的需要这个VBA代码吗？ 您可以简单地复制数据，然后通过右键单击>移调来粘贴。 那将会完成这项工作。
在VBA中应该这样工作：
Public Sub copyTrans() Range("A1:G3").Copy Range("A4").PasteSpecial Transpose:=True End Sub
（而不是Range("A1:G3") ，当然可以使用不同的函数来查找最后一个单元格）
编辑：对不起，我读了你的问题有点太快了。 移调将转换这个：
A a 2 3 4 5 6 B b 1 3 4 5 6 C c 1 2 4 6 7
对此：
ABC abc 2 1 1 3 3 2 4 4 4 5 5 6 6 6 7
这将扫描表单调用“Sheet1”并将结果输出到名为“sheet2”的表单中 ，我标记了要更改这些名称的位置，以便您可以根据需要拒绝它：
Sub NeferZhang() Dim Ws As Worksheet, _ Wop As Worksheet, _ Wrow As Integer, _ FirstRun As Boolean FirstRun = True '-------Change name here------- Set Ws = ThisWorkbook.Sheets("Sheet1") '-------Change name here------- Set Wop = ThisWorkbook.Sheets("Sheet2") Wop.Cells.ClearContents Wop.Cells.ClearFormats For i = 1 To Ws.Range("A" & Ws.Rows.Count).End(xlUp).Row For k = 3 To Ws.Range("A" & i).End(xlToRight).Column Wrow = Wop.Range("A" & Wop.Rows.Count).End(xlUp).Row + 1 If Wrow <> 2 And Not FirstRun Then 'Nothing to change Else 'Only change at the first try, to write on first row Wrow = 1 FirstRun = False End If Wop.Range("C" & Wrow + (k - 3)).Value = Ws.Cells(i, k).Value Next k 'Copy A and B columns Wop.Range("A" & Wrow & ":B" & Wrow + (k - 4)).Value = Ws.Range(Ws.Cells(i, 1), Ws.Cells(i, 2)).Value Next i Set Ws = Nothing Set Wop = Nothing End Sub