Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:B19999")) Is Nothing Then
With Target(1, 3)
.Value = Date
.EntireColumn.AutoFit
End With
End If
    Dim R&, RSheet&, ShName$
    Dim Rn As Range
    R = Target.Row
    Set Rn = Range(Cells(R, 2), Cells(R, 7))
    If WorksheetFunction.CountA(Rn) = 6 Then
        ShName = Cells(R, 11)
        On Error Resume Next
        With Sheets(ShName)
            If Err Then Exit Sub
            RSheet = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(RSheet, 1) = Val(.Cells(RSheet - 1, 1)) + 1
            Rn.Copy .Cells(RSheet, 2)
        End With
    End If
    Target.Activate
End Sub