Flyt linier fra et ark til et andet ark

Denne kan kanskje hjelpe?


Sub find()

Dim r As Long
Dim c As Range
Dim tmp() As Variant

Range("C1").Select
For Each c In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
  If c.Value = "Gennemført" Then
    tmp() = Cells(c.Row, 1).Resize(1, Cells(c.Row, Columns.Count).End(xlToRight).Column).Value
    c.EntireRow.Delete
   
    With Worksheets("Gennemført")
      r = .Cells(Rows.Count, 3).End(xlUp).Row + 1
      .Cells(r, 1).Resize(1, UBound(tmp, 2)) = tmp
    End With
  End If
Next
End Sub

ohh Yes.
Smid lige et svar så du kan få point

:-)