使用VBA脚本将列移动到用户选定范围内的行

Question

我正在尝试创建一个允许我选择一系列数据的VBA脚本，然后跳过该范围中的第一列，将值移到第一列下的后续列。

带有注释的Excel工作表的屏幕截图

我需要我的脚本才能让我选择一个范围。基于该范围，如果第一列不为null，则该行上剩余列的值（如果它们不为空）需要在该行的第一列下方复制并粘贴特殊（转置）。

我在绕过范围的最佳方式击败了我的大脑，但到目前为止这是我的脚本代码：

Sub ColsToRows()

Dim rng As Range
Set rng = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)

For Each Row In rng
    If Not IsNull(rng.Row) Then
        ActiveCell.Resize(1, 4).Copy
        ActiveCell.PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=True
    End If
Next

End Sub

为什么我收到选择错误（“此选项无效...”）？

Answer 1

这是为了实现我想要实现的目标而最终编造的代码：

Sub PhotoColumnsToRows()

Dim i As Long 'row counter
Dim j As Long 'URL counter - For counting amount of URLs to add
Dim LRow As Long 'last row

Application.ScreenUpdating = False 'turn screen updating off to stop flickering

LRow = Cells(Rows.Count, "A").End(xlUp).Row 'determine current last row

i = 2 'start at row 2

Do While i < LRow

    If IsEmpty(Cells(i, 11)) = False Then 'checks column K for data

        j = Application.WorksheetFunction.CountA(Range(Cells(i, 11), Cells(i, 13))) 'counts amount of Urls between K and M

        Rows(i + 1 & ":" & i + j).Insert 'insert amount of rows found from countA
        Range(Cells(i, 11), Cells(i, 11 + j - 1)).Copy 'copies specific range based on CountA
        Cells(i + 1, 10).PasteSpecial Transpose:=True 'pastespecial transpose below "J"
        Range(Cells(i, 11), Cells(i, 11 + j - 1)).ClearContents 'clear previously copied data
        LRow = LRow + j 'increments last row by the number of rows added


    End If

    i = i + 1 'increment loop
Loop

Application.ScreenUpdating = True 'turn back on screen updating

End Sub