使用VBA脚本将列移动到用户select的范围内

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

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

我需要我的脚本来允许我select一个范围。 根据该范围，如果第一列不为空，那么该行上其余列的值（如果它们不是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 

为什么我得到一个select错误（“这个select是无效的…”）？

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