插入細胞不平等的價值，複製，然後刪除插入的行

Question

您好但是它與數據的最後一個單元格後插入行我已經創建了以下兩個宏。我相信這是我的循環條件爲Do Until ActiveCell.Value = ""的結果。我想讓循環停止在數據的最後一個單元格。

我嘗試使用變量Do Until Loop_Long = LastRow但這並沒有爲我工作。

所有我想是有一個宏觀的插入與不同的數據單元格之間的行。然後是一個宏，它會在列中找到空單元格，我們先前插入的單元格，然後刪除該行。

所概述的問題上面它插入一個額外的行，而不是刪除它，如果你把值一路下行B柱之後，在A列數據，你會明白我的意思。

這裏是我的代碼：

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 

Answer 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