Excel-VB用于将当前行复制到单独的工作表

Question

我的工作电子表格直到最近一直在运作。代码如下所示。它旨在根据与匹配工作表对应的特定列中的值将主工作表中的一行复制到单独的工作表。

直到上周工作正常，我不确定它有什么问题。希望别人可以偷看。

Option Explicit

Private Sub cmdCopyLine_Click()
Dim NextNum As String
Dim SheetName As String
Dim X As Integer

On Error GoTo ErrorOut
'    Range("A7").Select
'    Selection.End(xlDown).Select
ActiveCell.EntireRow.Select
SheetName = ActiveCell.Offset(0, 2)
Range(ActiveCell, ActiveCell.Offset(0, 42)).Select
Selection.Copy
Sheets(SheetName).Activate
ActiveSheet.Range("A7").Select

For X = 0 To 500
    If ActiveCell.Offset(X, 0) = "" Then
        If Right(ActiveCell, 1) = "." Then NextNum = NextNum & "."
        ActiveCell.Offset(X, 0).Activate
        If NextNum = "" Then NextNum = 1
        Exit For
    End If
    NextNum = ActiveCell.Offset(X, 0) + 1
Next

ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False

ActiveCell.Offset(0, 0) = NextNum
Application.CutCopyMode = False
On Error GoTo 0
Exit Sub

ErrorOut:
Select Case Err.Number
    Case 9
        MsgBox "No sheet found for this Class ID", vbCritical + vbOKOnly, 
"Check Data Entry"
        Sheets("Overall Results").Activate
    Case Else
        MsgBox "Unknown error " & Err.Number & vbCrLf & Err.Description, 
vbCritical + vbOKOnly, "Check Data Entry"
End Select
Application.CutCopyMode = False

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub