一些更改：

1）首先，您需要更改为工作簿级别的事件：Workbook.SheetChange事件。

2）然后将Application.ActiveSheet更改为Sh。

3）如果在代码正文中使用Target，请确保将参数命名为Target。

4）添加一些错误处理以确保事件始终得到重新启用：

Private Sub Workbook_SheetChange(ByVal Sh As Object,_
                                 ByVal Target As Range)
    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Sh.Range("B:B"),Target)
    xOffsetColumn = -1
    If Not WorkRng Is Nothing Then
        On Error GoTo SafeExit
        Application.EnableEvents = False
        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0,xOffsetColumn).Value = Now
                Rng.Offset(0,xOffsetColumn).NumberFormat = "dd-mm-yyyy,hh:mm:ss"
            Else
                Rng.Offset(0,xOffsetColumn).ClearContents
            End If
        Next
    End If

SafeExit:
    Application.EnableEvents = True
End Sub

您可以考虑采取的一项措施（如果需要）是在Now之前抓住Loop，以防止出现不同的值。在这种情况下，您甚至可能根本不需要循环。考虑更换：

For Each Rng In WorkRng
    If Not VBA.IsEmpty(Rng.Value) Then
        Rng.Offset(0,xOffsetColumn).Value = Now
        Rng.Offset(0,hh:mm:ss"
    Else
        Rng.Offset(0,xOffsetColumn).ClearContents
    End If
Next

使用：

'Non empty cells with constants
If Application.CountA(WorkRng) > 0 Then
    Set Rng = WorkRng.SpecialCells(xlCellTypeConstants).Offset(0,-1)
    Rng.Value = Now
    Rng.NumberFormat = "dd-mm-yyyy,hh:mm:ss"
End If

并且：

'Empty Cells
If Application.CountBlank(WorkRng) > 0 Then
    WorkRng.SpecialCells(xlCellTypeBlanks).Offset(0,-1).ClearContents
End If

如果可以的话，您可以在@BigBen给出的答案内实现此目标。