if you want to make sure that all cells are filled change the copy part
of the code to:

If Application.CountA(aRng) = 4 Then
.Range("A" & Rows.Count).End(xlUp)(2) _
.Resize(1, 4).Value = aRng.Value
End If


Regards
Claus B.

Hi Claus,

I put the counta snippet in the same place as the other copy code and it does not respond.

I made sure all the sheets we enable events set back to True by running a little enable snippet on them.

Howard

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Intersect(Target, Range("D:D")) Is Nothing _
Or Target.Count 1 Then Exit Sub

If LCase(ActiveSheet.Name) < "summary" And _
LCase(ActiveSheet.Name) < "begin blad" Then

With Application
.EnableEvents = False
.ScreenUpdating = False
End With
On Error GoTo aft_error

Dim aRow As Long
Dim aRng As Range
Dim tRow As Long, i As Long

aRow = Target.Row

Set aRng = Range("A" & aRow).Resize(1, 4)

With Sheets("Summary")
For i = 1 To .ListObjects.Count
.ListObjects(i).Unlist
Next

'Write the last entry col A to col D to Summary sheet if there are 4 entries

'.Range("A" & Rows.Count).End(xlUp)(2) _
.Resize(1, 4).Value = aRng.Value

If Application.CountA(aRng) = 4 Then
.Range("A" & Rows.Count).End(xlUp)(2) _
.Resize(1, 4).Value = aRng.Value
End If


'reinstate Table1 to Summary sheet
tRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.ListObjects.Add(xlSrcRange, .Range("$A$3:$D$" & tRow), , xlYes) _
.Name = "Table1"
'.ListObjects("Table1").TableStyle = "TableStyleLight2"

End With
End If

aft_error:
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub