Eliminar fila después de copiar

Te paso la macro

Sub CopiarDatos()
'Por Adriel Ortiz
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    j = h2.Range("H" & Rows.Count).End(xlUp).Row + 1
    For i = 3 To h1.Range("H" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "H") = "cerrado" Then
             h1.Rows(i).Copy: h2.Range("A" & j).PasteSpecial xlValues
            j = j + 1
    End If
    Next
    Application.CutCopyMode = False
    Set h2 = Sheets("Hoja1")
    Set r = h2.Columns("H")
    Set b = r.Find("cerrado", lookat:=xlWhole)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            '
            h2.Cells(b.Row, "L") = "borrar"
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
    For i = h1.Range("L" & Rows.Count).End(xlUp).Row To 3 Step -1
        If h1.Cells(i, "L") = "borrar" Then h1.Rows(i).Delete
    Next
    MsgBox "Copia Finalizada"
End Sub

No olvides de valorar la respuesta Excelente o bueno saludos!

Adriel,

Ejecuto la macro y no elimina la fila que copio

Hice algunas modificaciones

Sub CopiarDatos()
'Por Adriel Ortiz
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    j = h2.Range("H" & Rows.Count).End(xlUp).Row + 1
    For i = 3 To h1.Range("H" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "H") = "cerrado" Then
             h1.Rows(i).Copy: h2.Range("A" & j).PasteSpecial xlValues
            j = j + 1
    End If
    Next
    Application.CutCopyMode = False
    Set h = Sheets("Hoja1")
    Set r = h.Columns("H")
    Set b = r.Find("cerrado", lookat:=xlWhole)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            '
            h.Cells(b.Row, "L") = "borrar"
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
    For i = h.Range("L" & Rows.Count).End(xlUp).Row To 3 Step -1
        If h.Cells(i, "L") = "borrar" Then h.Rows(i).Delete
    Next
    MsgBox "Copia Finalizada"
End Sub

Esto

Sub CopiarDatos()
'Por Adriel Ortiz
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    Application.ScreenUpdating = False
    j = h2.Range("H" & Rows.Count).End(xlUp).Row + 1
    For i = 3 To h1.Range("H" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "H") = "cerrado" Then
             h1.Rows(i).Copy: h2.Range("A" & j).PasteSpecial xlValues
            j = j + 1
    End If
    Next
    Application.CutCopyMode = False
    Set h = Sheets("Hoja1")
    Set r = h.Columns("H")
    Set b = r.Find("cerrado", lookat:=xlWhole)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            '
            h.Cells(b.Row, "L") = "borrar"
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
    For i = h.Range("L" & Rows.Count).End(xlUp).Row To 3 Step -1
        If h.Cells(i, "L") = "borrar" Then h.Rows(i).Delete
    Next
     Application.ScreenUpdating = True
    MsgBox "Copia Finalizada"
End Sub

Maquina realiza todo bien, pero sigue sin eliminar la fila

Si has cambiado el nombre de las hojas asegúrate de hacer en todas de caso contrario

Envíame tu archivo para adecuar la macro [email protected]

te envié el correo