Скопируйте данные с одного листа на другой и удалите строку из старого рабочего листа

Question

Это код, который я написал, но в основном я хочу скопировать данные с одного листа на другой с условием, например: «закрыто», что строка на старом листе должна быть удалена. Я смог скопировать строку на другой лист, но он копировал строку 4 раза, я не могу понять, почему. Вы можете посмотреть этот код? Я не настолько продвинутый с VBA.

Sub macro_1() 
Dim lr As Long, lr2 As Long, r As Long 
lr = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row 
For r = lr To 2 Step -1 
Last = Cells(Rows.Count, "G").End(xlUp).Row 
For i = Last To 2 Step 1 

If Range("G" & r).Value = "closed" Then 
    Rows(r).Copy Destination:=Sheets("Sheet2").Range("A" & lr2 + 1) 
    lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row 
End If 
    If (Cells(i, "G").Value) = "closed" Then 'Cells (i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW 
    Cells(i, "A").EntireRow.Delete 
End If 
Next i 

Next r 

End Sub 

Answer 1

Вам не нужен второй цикл, вот что вызывает проблемы.

Также рекомендуется всегда объявлять родителей о своих объектах. В приведенном ниже коде объявляются два листа, тогда каждый диапазон соответствует соответствующему листу. Таким образом, если по какой-либо причине фокус теряется на активном листе, ошибки не встречаются.

Он также упрощает переименование листов. Имя нужно только фиксировать в одном месте не так много.

Sub macro_1() 

Dim lr As Long, lr2 As Long, r As Long 
Dim ws1 As Worksheet, ws2 As Worksheet 

Set ws1 = Sheets("Sheet1") 
Set ws2 = Sheets("Sheet2") 

lr = ws1.Cells(Rows.count, "A").End(xlUp).Row 

For r = lr To 2 Step -1 
    lr2 = ws2.Cells(Rows.count, "A").End(xlUp).Row + 1 

    If ws1.Range("G" & r).value = "closed" Then 
     ws1.Rows(r).copy Destination:=ws2.Range("A" & lr2) 
     ws1.Cells(r, "A").EntireRow.Delete 
    End If 
Next r 

End Sub