Copying Specific Cells Excel to another sheet, and removing Conditional Formatting and Data Validation

Question

Need to run through a worksheet and copy Columns A through F on anything that has been marked "Sent to Client" or "Sendable" to a different worksheet, then remove the entire row from the first sheet. The version I've been working with currently functions, but copies the entire row over, but the second sheet doesn't need cells G through J, as the data in those columns is different.

Additionally, the conditional formatting and Data validation on the first sheet is irrelevant on the second sheet, but is copied over in the process.

The code I've been working with is this:

Sub MoveToClientShipping()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRow As Long
    ' Case sensitivity is a bitch.
    With Range("D1", Cells(Rows.Count, "D").End(xlUp))
        .Value = Evaluate("INDEX(Proper(" & .Address(External:=True) & "),)")
    End With
   
    ' Set the source and target sheets
    Set sourceSheet = ThisWorkbook.Worksheets("Model Storage List")
    Set targetSheet = ThisWorkbook.Worksheets("Client Ship List")

    ' Find the last row in the source sheet
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "D").End(xlUp).Row
    ' Find the first row in the target sheet | This line might be redundant, but I'm afraid to remove it.
    Set startrow = targetSheet.Range("A6")
    ' Find the next empty cell in column A on the target sheet
    NextFree = targetSheet.Range("A2:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    Range("A" & NextFree).Select
    ' Last row in column D on the target sheet
    targetRow = targetSheet.Cells(targetSheet.Rows.Count, "D").End(xlUp).Row
    ' Loop through each row in the source sheet
    For i = lastRow To 1 Step -1
    ' Check if cell in column D contains "Sendable"
    If sourceSheet.Cells(i, "D").Value = "Sendable" Then
            ' Increment target row
            targetRow = targetRow + 1
            ' Copy the entire row to the target sheet
            sourceSheet.Rows(i).Copy Destination:=targetSheet.Cells(targetRow, 1)
            ' Delete the row from the source sheet
            sourceSheet.Rows(i).Delete
        End If
    ' Check if cell in column D contains "Sent To Client"
    If sourceSheet.Cells(i, "D").Value = "Sent To Client" Then
            ' Increment target row
            targetRow = targetRow + 1
            ' Copy the entire row to the target sheet
            sourceSheet.Rows(i).Copy Destination:=targetSheet.Cells(targetRow, 1)
            ' Delete the row from the source sheet
            sourceSheet.Rows(i).Delete

    Next i
    
    MsgBox ("Client Ship List Populated | Please fill in missing criteria.")
        
End Sub

I've tried modifying this block I found in my searching to remove the cells, but it deletes all the existing data in the second sheet's G through J columns (which makes sense, considering it literally says "EntireColumn.Delete).

 For i = rgOut.Columns.count To 1 Step -1
 Select Case i
 Case 1, 6
 Case Else
 rgOut.Columns(i).EntireColumn.Delete
 End Select
 Next i

Answer 1

Consider changing your loop code as below:

For i = lastRow To 1 Step -1
' Check if cell in column D contains "Sendable" or "Sent To Client"
    Select Case SourceSheet.Cells(i, "D").Value
        Case "Sendable", "Sent To Client"
            ' Increment target row
            targetRow = targetRow + 1
            ' Copy columns A:F to the target sheet
            SourceSheet.Range("A" & i & ":F" & i).Copy Destination:=targetSheet.Cells(targetRow, 1)
            ' Delete the row from the source sheet
            SourceSheet.Rows(i).Delete
            With targetSheet.Cells(targetRow, 1).Resize(, 6)
                .FormatConditions.Delete
                .Validation.Delete
            End With
     End Select
Next i