8行到列与空白VBA

这段代码应该满足您的要求

Sub test()
Dim startRow As Integer
Dim startColumn As Integer
Dim LastRow As Integer
Dim LastColumn As Integer
Dim actRow As Integer
Dim actColumn As Integer
Dim targetRow As Integer
startRow = 1   
startColumn = 1
LastRow = 8
LastColumn = 6
targetRow = LastRow + 1
For actColumn = startColumn + 1 To LastColumn
    For actRow = startRow To LastRow
        With ActiveSheet
            .Cells(targetRow, 1) = .Cells(actRow, actColumn)
            .Cells(actRow, actColumn).Clear
        End With
        targetRow = targetRow + 1
    Next actRow
Next actColumn
End Sub

您可以改进代码，例如用Sheets("sheetname")代替

下面的代码是非常通用的，可以根据您的UI需要进行修改。

逻辑如下:

1. 将范围复制到内存
2. 根据需要将内容重新排列成一维字符串数组
3. 用换行符(Windows为CRLF)连接数组中的元素
4. 将此连接字符串复制到系统剪贴板

因此，您可以突出显示您想要重新排列的范围，并通过电子表格上的某个按钮或功能区中的按钮运行宏，所需的输出将被放入剪贴板。

然后你可以简单地粘贴到任何你需要使用它的地方。

    Sub CopyToClipboard()
        Dim Clipboard As New MSForms.DataObject
        ' Create Clipboard data object
        Dim CopiedArray As Variant
        CopiedArray = Selection
        ' Randomly sized range copied
        Dim nRows As Long, nCols As Long
        nRows = UBound(CopiedArray, 1)
        nCols = UBound(CopiedArray, 2)
        Dim OutputStr() As String
        ReDim OutputStr(1 To nRows * nCols)
        ' Create a uni dimensional string array for output
        Dim i As Long, j As Long
        For j = 1 To nCols
            For i = 1 To nRows
                OutputStr((j - 1) * nRows + i) = CopiedArray(i, j)
            Next i
        Next j
        Clipboard.SetText Join(OutputStr, vbCrLf)
        ' The string array is joined with the
        ' Carriage Return + LineFeed (CRSF) delimiter

        Clipboard.PutInClipboard
        ' Contents of the Clipboard object are
        ' copied to the system clipboard
        Set Clipboard = Nothing
        ' Destroy clipboard object
    End Sub