Copying rows based on text in cell if not already existing in new sheet

[Olavfinnerud]

Hi,
I want to check column D:D for the text "Offentlig" and copy the entire row into another sheet. But if the row already exist in the other sheet i dont want it to copy and paste it, which my code does. If a new row is added with the text "offentlig" in the corresponding D cell i want this to automatically apear in the new sheet. The code I have doesent work properly, but i got some of it from chatgpt so that probably explains it. I also have two subs, it would be prefable to have 1 sub. Can someone help me with this, thanku in advance.

This is the code i have:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Offentlig")
    
    If Target = "Offentlig" Then
        Target.EntireRow.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
        
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Sub priority()
    Dim Cll As Range
    Dim Rng As Range
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim LastRow As Long

    
    Set SourceSheet = ThisWorkbook.Sheets("sheet1")
    Set TargetSheet = ThisWorkbook.Sheets("Offentlig")

    
    LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "D").End(xlUp).Row
    Set Rng = SourceSheet.Range("D6:D" & LastRow)

  
    For Each Cll In Rng
      
        If Cll.Value = "Offentlig" Then
            
            Cll.EntireRow.Copy
            TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next Cll

  
    Application.CutCopyMode = False
End Sub

Below is a image of the sheet i want to copy from, and it should be pastet into the sheet named offentlig.

 

[OaklandJim]

I can't promise that I can do this but I'll try. If not me then possibly other people who are smarter about Excel.

If you want assistance you are more likely to get help if you help the helper so they do not need to guess about or recreate your data.

Pictures are not very helpful. If the data is not confidential post a link to your workbook. If necessary you can enter fake-but-realistic data before providing the link. Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the Mr Excel message area. Make sure that other people can access the file!

Or, consider sharing relevant data using Mr Excel's excellent XL2BB addin that enables you to post a portion of a worksheet. See XL2BB - Excel Range to BBCode for details.

 

[Olavfinnerud]

I can't promise that I can do this but I'll try. If not me then possibly other people who are smarter about Excel.

If you want assistance you are more likely to get help if you help the helper so they do not need to guess about or recreate your data.

Pictures are not very helpful. If the data is not confidential post a link to your workbook. If necessary you can enter fake-but-realistic data before providing the link. Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the Mr Excel message area. Make sure that other people can access the file!

Or, consider sharing relevant data using Mr Excel's excellent XL2BB addin that enables you to post a portion of a worksheet. See XL2BB - Excel Range to BBCode for details.

Okey, thank you for the feedback.