Is it possible to change this so if the contents of cell b5 is deleted then j5 would be deleted too. b6 deleted , j6 would be deleted etc.etc 

Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("Headed Paper").Range("N1").Value = Sheets(ActiveSheet.Name).Range("A2").Value
Sheets("Headed Paper").Range("O1").Value = Sheets(ActiveSheet.Name).Range("A3").Value

Dim shSource As Worksheet, shDestination As Worksheet, iR As Long, i As Byte


Set shSource = ActiveSheet
Set shDestination = Sheets("Invoice Template") ' =Sheet4
On Error Resume Next
If Target.Count > 1 Then Exit Sub
If (Not Intersect(Target, shSource.Range("J5:J500")) Is Nothing) And Target.Cells.Count = 1 Then
If UCase(Target.Value) = "Y" Then
Worksheets("Invoice Template").Visible = True
Dim aso(), aco()
aso = Array("A", "B", "C", "D", "G", "F", "H", "I")
aco = Array("B14", "B16", "F16", "D35", "D36", "D37", "D38", "D39")

iR = Target.Row
For i = 0 To UBound(aso)
If IsEmpty(Range("B" & iR)) Then

Sheet4.Visible = False
    MsgBox "Please insert job name"
    Range("J" & iR).ClearContents
    Exit Sub
End If
Range("J" & iR).FormulaR1C1 = "DONE"
shDestination.Range(aco(i)).Value = shSource.Range(aso(i) & iR).Value
Next
With Sheets("Invoice Template")
.Range("N1").Value = Sheets(ActiveSheet.Name).Range("A2").Value
.Range("O1").Value = Sheets(ActiveSheet.Name).Range("A3").Value

End With
Range("o3").Value = ("J" & iR)
shDestination.Protect
shDestination.Select
Sheet1.Visible = False
Sheet2.Visible = False
Sheet5.Visible = False
End If
End If
Application.EnableEvents = True
End Sub
Many Thanks