如何在1列中复制范围和粘贴

Question

Anyone Have Some Idea to make something like this with VBA in Excel . Please...

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  

to be pasted just on 1 column B or Range (B3 : B33) like below:

1

2

3

4

5

6

7

....etc

30

Answer 1

Try with below code. It will work

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

if you need to paste only values

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

if you need to paste "all" cell

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

I see you have an accepted answer, but here is an alternative solution using formula 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

Note that it only copy-paste the value, its format's excluded.