Hi Peter,

Try this - just not sure what you want in column G of Sheet4. As entries only with a reg number in column B of SHEET1 are copied over to to Sheet4, row 8 is ignored. I've included some notes to help show you what the code is doing.

If this isn't right I'd suggested starting a new thread as you're original question has been answered and what you're now asking for is now totally different.

Regards,

Robert

Code:
Option Explicit
Sub Macro1()

    Const lngStartRow As Long = 3 'Commencement row number for data. Change to suit.
    
    Dim lngEndRow As Long
    Dim rngCell As Range
    Dim lngMyRow As Long
    Dim ws1 As Worksheet, _
        ws2 As Worksheet
        
    Application.ScreenUpdating = False
        
    Set ws1 = Worksheets("SHEET1")
    Set ws2 = Worksheets("Sheet4")
    
    lngEndRow = ws1.Range("A:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Find the last row in ws1 from columns A to M (inclusive)
    
    For Each rngCell In ws1.Range("B" & lngStartRow & ":B" & lngEndRow)
        'If there's a reg number in column B of the current row, then...
        If Len(rngCell) > 0 Then
            On Error Resume Next
                '...try and find if it's already been copied to Sheet4
                lngMyRow = 0 'Initialise variable
                'Note if the reg number becomes numeric, you'll need to remove the double quotation marks around rngCell
                lngMyRow = Evaluate("MATCH(""" & rngCell & """," & CStr(ws2.Name) & "!B:B,0)")
            On Error GoTo 0
            'If the reg number is already in Sheet4 then...
            If lngMyRow <> 0 Then
                '...link the data from SHEET1 to the applicable row in Sheet4
                ws2.Range("A" & lngMyRow).Value = ws1.Range("A" & rngCell.Row).Value
                ws2.Range("B" & lngMyRow).Value = ws1.Range("B" & rngCell.Row).Value
                ws2.Range("C" & lngMyRow).Value = ws1.Range("E" & rngCell.Row).Value
                ws2.Range("D" & lngMyRow).Value = ws1.Range("F" & rngCell.Row).Value
                ws2.Range("E" & lngMyRow).Value = ws1.Range("G" & rngCell.Row).Value
                ws2.Range("F" & lngMyRow).Value = ws1.Range("H" & rngCell.Row).Value
                ws2.Range("H" & lngMyRow).Formula = "=D" & lngMyRow & "-E" & lngMyRow
            'Else...
            Else
                '...find the next available row in Sheet4 and then link the data from SHEET1 to that row.
                lngMyRow = ws2.Range("A:H").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 'Find the last row in ws2 from columns A to H (inclusive) and increment this by 1
                ws2.Range("A" & lngMyRow).Value = ws1.Range("A" & rngCell.Row).Value
                ws2.Range("B" & lngMyRow).Value = ws1.Range("B" & rngCell.Row).Value
                ws2.Range("C" & lngMyRow).Value = ws1.Range("E" & rngCell.Row).Value
                ws2.Range("D" & lngMyRow).Value = ws1.Range("F" & rngCell.Row).Value
                ws2.Range("E" & lngMyRow).Value = ws1.Range("G" & rngCell.Row).Value
                ws2.Range("F" & lngMyRow).Value = ws1.Range("H" & rngCell.Row).Value
                ws2.Range("H" & lngMyRow).Formula = "=D" & lngMyRow & "-E" & lngMyRow
            End If
        End If
    Next rngCell
    
    Application.ScreenUpdating = True

End Sub
Robert