如何复制范围并粘贴到 1 列

Question

任何人都有想法在 Excel 中使用 VBA 制作类似的东西。请...

Range (D2 : M4) 

1   2  3  4  5  6  7  8  9  10

11 12 13 14 15 16 17 18 19 20

21 22 23 24 25 26 27 28 29 30

仅粘贴在 1 列 B 或范围 (B3 : B33) 上，如下所示：

1

2

3

4

5

6

7

....etc

30

Answer 1

试试下面的代码。它会起作用

Sub test()
    Dim i As Long
    For i = 2 To 4
        If i = 2 Then
            Sheets("Sheet3").Range("D" & i, "M" & i).Copy
            Sheets("Sheet3").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Else
            Sheets("Sheet3").Range("D" & i, "M" & i).Copy
            Sheets("Sheet3").Range("B" & Sheets("Sheet3").Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End If
    Next i
End Sub

Answer 2

如果您只需要粘贴值

Sub main()
    Dim i As Long
    Dim cell As Range

    For Each cell In Range("D2:M4")
        Range("B3").Offset(i).Value = cell.Value
        i = i + 1
    Next cell
End Sub

如果需要粘贴"all"单元格

Sub main()
    Dim i As Long
    Dim cell As Range

    For Each cell In Range("D2:M4")
        cell.Copy Destination:=Range("B3").Offset(i)
        i = i + 1
    Next cell
End Sub

Answer 3

我看到你有一个可接受的答案，但这里有一个使用公式 TRANSPOSE:

的替代解决方案

Sub TransposeData()
Dim Data As Range, iRow&, RowData&, ColData&

Set Data = Worksheets("Sheet1").Range("D2:M4")
RowData = Data.Rows.Count: ColData = Data.Columns.Count

For iRow = 1 To RowData
    Range("B" & 3 + (iRow - 1) * ColData).Resize(ColData, 1) = WorksheetFunction.Transpose(Data.Rows(iRow))
Next

End Sub

请注意，它只是复制粘贴值，不包括其格式。

如何复制范围并粘贴到 1 列

How to Copy Range And Paste in 1 Column

excel

vba

excel-2007

excel-2010