excel 如何复制行，插入两行然后粘贴数据？

kzmpq1sx 于 2023-02-20 发布在其他

关注(0)|答案(1)|浏览(115)

I have code that runs through column E (Column C in example below) and searches for any change in data. It then inserts a blank row under that change and loops through the set of data (200-500 rows long).
I want a "copy and paste" feature of the last row of data, before the change, into the newly inserted row.
Before:
| Column A | Column B | Column C | Column E |
| ------------ | ------------ | ------------ | ------------ |
| 1 | 2 | Sally | 5 |
| 1 | 2 | Sally | 6 |
| 1 | 2 | Sally | 2 |
| 1 | 2 | Chase | 1 |
| 1 | 2 | Chase | 4 |
| 1 | 2 | Ben | 9 |
After:
| Column A | Column B | Column C | Column E |
| ------------ | ------------ | ------------ | ------------ |
| 1 | 2 | Sally | 5 |
| 1 | 2 | Sally | 6 |
| 1 | 2 | Sally | 2 |
| | 2 | Sally | |
| 1 | 2 | Chase | 1 |
| 1 | 2 | Chase | 4 |
| | 2 | Chase | |
| 1 | 2 | Ben | 9 |
| | 2 | Ben | |
The code I have has a loop:

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 = ""
'

excel

来源：https://stackoverflow.com/questions/65890535/how-to-copy-row-insert-tow-under-then-paste-data

1条答案

按热度按时间

gojuced71#

编辑日期：：

请尝试更新代码：

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列”是标题，它们位于工作表的第一行。
请进行测试并发送一些反馈

赞(0）回复(0）举报 2023-02-20

我来回答

excel 如何复制行，插入两行然后粘贴数据？

1条答案

相关问题

热门标签

最新问答