Excel cut and insert based on a cell value

Question

In a shared workbook I'm getting a 1004 error about: "Insert method of range failed."

I have been using the following code for years. (Non shared mode)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim wb As Workbook
Dim ws1 As Worksheet
Dim x As Integer
Dim y As Integer
Dim score As Long
Dim scoreRow As Long
Set wb = ActiveWorkbook
Application.EnableEvents = False
Application.ScreenUpdating = False
If Target.Column >= 2 And Target.Column <= 10 And Target.Row >= 5 And 
  Target.Row <= 9 Then
  Set ws1 = Worksheets(1)
  For x = 10 To 19
    score = ws1.Cells(x, 14).Value
    scoreRow = x
      For y = x + 1 To 19
        If ws1.Cells(y, 14).Value > score Then
        score = ws1.Cells(y, 14).Value
        scoreRow = y
  End If 'strange... It looks to stay better after the next code line...
     Next y
 'Next x is missing, too...

If scoreRow <> x Then
  ws1.Cells(scoreRow, 13).Cut
  ws1.Cells(x, 13).Insert
  ws1.Cells(scoreRow, 14).Cut
  ws1.Cells(x, 14).Insert
End If
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Any help to adjust to a Shared workbook would be great. The rows 10 to 19 only contain the data i am manupulating (sorting)

Answer 1

As a result, you should end up with code like this:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    Dim wb          As Workbook
    Dim ws1         As Worksheet
    Dim x           As Integer
    Dim y           As Integer
    Dim score       As Long
    Dim scoreRow    As Long
    Set wb = ActiveWorkbook
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    If Target.Column >= 2 And Target.Column <= 10 And Target.Row >= 5 And Target.Row <= 9 Then
        Set ws1 = Worksheets(1)

        For x = 10 To 19
            score = ws1.Cells(x, 14).Value
            scoreRow = x

            For y = x + 1 To 19

                If ws1.Cells(y, 14).Value > score Then
                    score = ws1.Cells(y, 14).Value
                    scoreRow = y
                End If    'strange... It looks to stay better after the next code line...

            Next y
            'Next x is missing, too...

            If scoreRow <> x Then
                ws1.Cells(scoreRow, 13).Cut
                ws1.Cells(x, 13).Insert
                ws1.Cells(scoreRow, 14).Cut
                ws1.Cells(x, 14).Insert
            End If

            ActiveWorkbook.Save
        Next

    End If

    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub