复制选定的行两次

我已经写了一个非常基本的Excelmacros来复制选中的行两次，然后将光标向下移动3行，以便可以重复该过程。

所以如果我有一个文件，前10行都需要重复两次，我运行macros10次。

这已经为我节省了一堆击键，但我相信它可以写得更好，所以我只需select前10行，然后运行一次macros。

以下是我到目前为止：

Sub Copy_Twice() ' Copies current row twice ActiveCell.EntireRow.Select Selection.Copy Selection.Insert Shift:=xlDown ActiveCell.EntireRow.Select Selection.Copy Selection.Insert Shift:=xlDown ActiveCell.Offset(rowOffset:=3).Select End Sub 

对于运行此macros的每个文件，它可能不是要复制的前10行。

实际上，如果J列中的单元格为空白，则更好的macros将是每行复制两次。

更新：文件具有包含列A到X的值的标题行。要复制的行将是J列为空的标题之后的前x行。 所以在一个例子中，第2-11行需要被复制两次。 但在另一个文件中，可能是第2-21行。

Answer 1

尝试这个：

 Dim n&, x& n = 0 x = Application.WorksheetFunction.CountIf(Range("J:J"), " ") Range("A2").Select While n <> x ActiveCell.EntireRow.Copy: ActiveCell.Offset(1, 0).EntireRow.Insert ActiveCell.EntireRow.Copy: ActiveCell.Offset(1, 0).EntireRow.Insert ActiveCell.Offset(3, 0).Select n = n + 1 Wend Application.CutCopyMode = False End Sub 

Answer 2

我可以玩吗？ ：P

这是最快的方法。 假设您的数据来自单元格A1:A10 。 只需运行这个代码。

您不必使用复制/粘贴 。

这段代码的作用是插入空白行，然后模拟Ctrl + G – > Special – > Blank Cells – >用上面一行中的数据填充空白单元格，使用CTRL + ENTER 。

 For i = 10 To 2 Step -1 Rows(i).Insert: Rows(i).Insert Next i '~~> After the blank rows are inserted your range will '~~> expand up to row 30 Range("A1:A30").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" Range("A1:A30").Value = Range("A1:A30").Value '<~~ Convert formuals back to values 

Answer 3

下面是一些代码，允许用户input行数并testingJ列是否为每行的空白：

 Sub CopyRows() Dim x As Integer x = InputBox("How Many Rows to Copy?", 8) Dim c As Range Set c = Range("A2") Dim y As Integer For y = x to c.Row Step -1 If IsEmpty(Cells(y, "J")) Then Cells(y,1).EntireRow.Copy: Cells(y,1).Resize(2,1).EntireRow.Insert Shift:=xlDown End If Next End Sub 

Answer 4

如果可以依赖列A来显示要处理的行的范围，则查找列A中的最后一个已填充的行并且处理第2行应覆盖要处理的所有行。

 Sub add_Duplicate_Blank_Js() Dim rw As Long With Worksheets("Sheet4") With .Cells(1, 1).CurrentRegion For rw = .Rows.Count To 2 Step -1 If Not CBool(Len(.Cells(rw, "J"))) Then With .Rows(rw).Cells .Copy .Resize(2, .Columns.Count).Insert Shift:=xlDown End With End If Next rw Application.CutCopyMode = False End With End With End Sub 

将第一行和第A列中的标题填充到数据的完整范围内时，上面将从Range.CurrentRegion属性的底部向上（在For Next语句中插入或删除行时推荐使用） 。