Loops 在不等值后插入单元格，复制，然后删除插入的行

您好，我已经创建了以下两个宏，但是它在最后一个包含数据的单元格后面插入了一行。我相信这是由于我的循环条件是

Do-Until-ActiveCell.Value=”“

。我想让循环在最后一个有数据的单元格停止

我尝试使用变量

Do直到Loop\u Long=LastRow

，但这对我不起作用

我只想让宏在具有不同数据的单元格之间插入一行。然后是一个宏，它将在列中找到我们之前插入的空单元格，然后删除该行

如上所述，问题是它插入了一个额外的行，而不是删除它，如果您将值一直放在列A中的数据之后的列B中，您将看到我的意思

这是我的密码：

Option Explicit

Sub Macro1()
'Insert Blank Row Between Names
Sheets("Sheet1").Select

Range("A1").Select
Do Until ActiveCell.Value = ""
    If ActiveCell.Value <> ActiveCell.Offset(1).Value Then
        ActiveCell.Offset(1).EntireRow.Insert
        ActiveCell.Offset(1).Select
    End If
    ActiveCell.Offset(1).Select
 Loop
End Sub

Sub Macro2()

Dim LastRow As Long

'Delete Inserted Rows
Sheets("Sheet1").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & LastRow).Select
Do Until ActiveCell.Value = Range("A1")
    If ActiveCell.Value <> ActiveCell.Offset(-1).Value Then
        ActiveCell.Offset(-1).EntireRow.Delete Shift:=xlUp
        ActiveCell.Offset(-1).Select
    End If
    ActiveCell.Offset(-1).Select
Loop
End Sub

选项显式
亚宏观1（）
'在名称之间插入空行
图纸（“图纸1”）。选择
范围（“A1”）。选择
直到ActiveCell.Value=“”
如果ActiveCell.Value ActiveCell.Offset（1.Value），则
ActiveCell.Offset（1）.EntireRow.Insert
ActiveCell.Offset（1）。选择
如果结束
ActiveCell.Offset（1）。选择
环
端接头
亚宏观经济2（）
最后一排一样长
'删除插入的行
图纸（“图纸1”）。选择
LastRow=单元格（Rows.Count，“A”）.End（xlUp）.Row
范围（“A”&最后一行）。选择
直到ActiveCell.Value=Range（“A1”）
如果ActiveCell.Value ActiveCell.Offset（-1）.Value则
ActiveCell.Offset（-1）.EntireRow.Delete Shift:=xlUp
ActiveCell.Offset（-1）。选择
如果结束
ActiveCell.Offset（-1）。选择
环
端接头

根据您告诉我的，下面的代码应该适合您（并且它更好地遵循最佳实践）。。。您是否考虑过按原样复制数据，然后在将数据粘贴到新位置后插入行？那就少了一步

Option Explicit
'Declare module-level variables.
Dim sht As Worksheet
Dim Cell As Range
Dim NameRng As Range
Dim LastRow As Long

Sub test()
'Add blank rows.
Set sht = ActiveWorkbook.Sheets("Sheet1")
LastRow = sht.Range("A" & Rows.count).End(xlUp).Row

Set NameRng = sht.Range("A1:A" & LastRow)

For Each Cell In NameRng
    If Cell <> Cell.Offset(1, 0) And Cell <> "" Then
        Cell.Offset(1, 0).EntireRow.Insert
    End If
Next Cell

End Sub
Sub test2()
'Delete blank rows.
Set sht = ActiveWorkbook.Sheets("Sheet1")
LastRow = sht.Range("A" & Rows.count).End(xlUp).Row

Set NameRng = sht.Range("A1:A" & LastRow + 1)

For Each Cell In NameRng
    If Cell = "" Then
        Cell.EntireRow.Delete
    End If
Next Cell

End Sub

选项显式
'声明模块级变量。
将sht变暗为工作表
暗淡单元格作为范围
Dim NameRng As范围
最后一排一样长
子测试（）
'添加空行。
Set sht=ActiveWorkbook.Sheets（“Sheet1”）
LastRow=sht.Range（“A”&Rows.count）.End（xlUp）.Row
Set NameRng=sht.Range（“A1:A”和LastRow）
对于NameRng中的每个单元格
如果单元格偏移量（1，0）和单元格“”，则
单元格偏移量（1，0）.EntireRow.Insert
如果结束
下一个细胞
端接头
子测试2（）
'删除空行。
Set sht=ActiveWorkbook.Sheets（“Sheet1”）
LastRow=sht.Range（“A”&Rows.count）.End（xlUp）.Row
Set NameRng=sht.Range（“A1:A”和LastRow+1）
对于NameRng中的每个单元格
如果Cell=”“，则
Cell.EntireRow.Delete
如果结束
下一个细胞
端接头

首先，您在这里的目标是什么，因为删除刚刚创建的行似乎有违目的。。。其次，这个代码对我来说很好。如果B列中有数据，是否希望跳过该行？@ARich示例A1:A9都是不同的名称。我想在它们之间留一个空格，然后复制并粘贴到其他地方，然后删除插入的行。此代码在最后一个具有名称的单元格后插入一行，但不删除该行。运行此代码后，A18是一个空行，不应插入此行，然后运行delete宏，其结果是A10是一个空行。在复制之前，我需要在信息之间插入行，因为我将一组列合并在一起，所以粘贴后我无法比较单元格，因为它们都是唯一的。我现在继续，没有插入空格，我将在完成工作簿的所有其他方面后重新访问它。感谢您的投入，非常感谢。