修改macros只适用于select，而不是整个工作表

我有一个macros需要一个列，基本上重复每一行：

Sub Duper() Dim LR As Long Dim i As Long LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row For i = LR To 1 Step -1 Rows(i).Copy Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown Application.CutCopyMode = False Next i End Sub 

input

101
102
103
104
105

产量

101
101
102
102
103
103
104
104
105
105

但是，我无法添加新数据，只能复制新数据，因为macros适用于整个工作表。

我需要添加到这个macros，这将允许我只对所选单元格运行macros？

Answer 1

只做选定的单元格：

 Sub Duper() Dim i As Long For i = (Selection.Row + Selection.Rows.Count - 1) To Selection.Row Step -1 Rows(i).Copy Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown Application.CutCopyMode = False Next i End Sub 

所以select你想要的单元格，然后运行它。

Answer 2

build议你使用数组而不是循环（为了速度）：

 Sub EddieBetts() Dim rng1 As Range Dim X, Y Dim lngCnt As Long Set rng1 = Selection X = Application.Transpose(Selection) ReDim Y(1 To UBound(X) * 2) For lngCnt = 1 To UBound(X) Y(2 * lngCnt - 1) = X(lngCnt) Y(2 * lngCnt) = X(lngCnt) Next rng1.Offset(rng1.Rows.Count).Rows.Insert xlDown rng1.Resize(rng1.Rows.Count * 2).Value2 = Application.Transpose(Y) End Sub