Excel 宏 - 复制行 -> 在下方插入行 -> 粘贴数据

问题描述

我有一个代码，它贯穿 E 列（下面示例中的 C 列）并搜索数据中的任何更改。然后在该更改下插入一个空白行并循环遍历数据集（200-500 行）。我正在寻找一种方法来修改/添加到代码的最后一行数据的“复制和粘贴”功能，在更改之前，到新插入的行。

之前：

A 列	B列	C 列	E 列
1	2	莎莉	5
1	2	莎莉	6
1	2	莎莉	2
1	2	追逐	1
1	2	追逐	4
1	2	本	9

之后：

A 列	B列	C 列	E 列
1	2	莎莉	5
1	2	莎莉	6
1	2	莎莉	2
	2	莎莉
1	2	追逐	1
1	2	追逐	4
	2	追逐
1	2	本	9
	2	本

我道歉。新来的。我目前拥有的代码有一个循环。见打击：

Sub CleanUpPart2()

'Insert Rows by column F

'
    Dim iRow As Integer,iCol As Integer
    Dim oRng As Range

    Set oRng = Range("f1")

    iRow = oRng.Row
    iCol = oRng.Column

    Do
'
    If Cells(iRow + 1,iCol) <> Cells(iRow,iCol) Then
        Cells(iRow + 1,iCol).EntireRow.Insert Shift:=xlDown
        iRow = iRow + 2
    Else
        iRow = iRow + 1
    End If
'
    Loop While Not Cells(iRow,iCol).Text = ""
'

解决方法

编辑：：

请尝试更新的代码：

Sub testInsertRowCopyBefore()
  Dim sh As Worksheet,lastRow As Long,i As Long
  
  Set sh = ActiveSheet
  lastRow = sh.Range("A" & Rows.count).End(xlUp).row
  
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
   For i = lastRow + 1 To 3 Step -1
    If sh.Range("C" & i).Value <> sh.Range("C" & i - 1).Value Then
        sh.Range("C" & i).EntireRow.Insert xlUp
        sh.Range("B" & i & ":C" & i).Value = sh.Range("B" & i - 1 & ":C" & i - 1).Value
    End If
   Next i
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  MsgBox "Ready..."
End Sub

上面的代码假设“A 列”、“B 列”和“C 列”是标题，它们保留在工作表的第一行。

请测试并发送一些反馈

copy excel excel insert paste