reference - あるワークブックから別のワークブックへのワークシートの移動と数式の更新 (リンク)

Question

これを解決し、コードを少し調整したところ、正常に動作するようになりました。新しいコードを投稿しようとはしません。試行するたびに、コード ブロックの上下にコードのビットができてしまうからです。

---

共有ワークブックで大きな問題が発生しているため、簡単な修正として、多数のワークシートを共有ワークブックから個々のワークブックに移動するコードをいくつか作成しました。このワークブックは、各ユーザーが排他的に開くことができます。

それらを（上記のように）移動すると、メインのワークブックからワークシートが削除され、1つの（同じ）ワークシートで新しいワークブックが作成され、すべての式が更新されます（リンクは新しいワークブックの外部になります）。

それらを元に戻そうとすると、ワークシートがメインのワークブックに「コピー」されますが、ワークシートは個々のワークブックに残り、数式は更新されません (実際には、数式が壊れているように見えます。処理する）。

私がやりたいのは、個々のワークブックからワークシートを削除し、メインのワークブックに戻し、リンクを更新することです。

これが私のコードです：

Public Sub ResourceMerge()

'-- Rich Head, 5/12/2012
'-- Merges the separated resource worksheets into the main workbook (sledge hammer to fix
'-- shared workbooks issue) which has arisen since XP rollout

    'Handle errors
    On Error GoTo Err

    'Variables
    Dim wbResourceNames(1 To 20), cv, myName As String, _
        ws As Worksheet, _
        wb, targetwb As Workbook, _
        x, i As Integer

    'Before any changes made, backup the master workbook
    myName = ActiveWorkbook.Name                                        'Get current workbook name
    myName = Mid(myName, 1, Len(myName) - 4)                            'Remove the .xls"
    myName = myName & "_backup2_" & Format(Date, "d mmm yyyy") & ".xls" 'Add "_backup current date.xls"
    ActiveWorkbook.SaveCopyAs myName                                    'Save a copy with the new name
    Set targetwb = Application.ActiveWorkbook                           'Store the main workbook

    'Make the people control panel sheet active and select cell B8 (row above first name)
    Set ws = Sheets("People Control Panel")
    ws.Activate
    ActiveSheet.Range("B8").Activate

    'Loop down through the names (ignoring any Spare) to get all the resource names
    x = 0
    Do Until x = 20                                         'Assumes maximum 20 resources
        x = x + 1
        Debug.Print x
        ActiveCell.Offset(Rowoffset:=1).Activate            'Move down one cell
        If Left(ActiveCell.Value, 5) = "Spare" Then         'Ignore 'spare' rows
            GoTo Loopy
        End If
        wbResourceNames(x) = ActiveCell.Value               'Get the resource name
        Set wb = Workbooks.Open(wbResourceNames(x))         'Open the individual resource worksheet
        'Move sheet back into main workbook
        wb.Sheets(1).Move _
        after:=targetwb.Sheets(targetwb.Sheets("OFF SHORE"))
        wb.Close                                            'Close new workbook
Loopy:
    Loop                                                    'Do next resource

'    ActiveWorkbook.Save                                     'Save the reduced master

GoTo Endy                                                   'All done

Err:
    If Err = 9 Then                                         'Incorrect worksheet name?
        MsgBox "The VBA code has trapped an error ('subscript out of range'), this is likely to be " & _
            "because a resource name from the 'People Control Panel' (a hidden worksheet) does not " & _
            "match the name of the worksheet; please delete this spreadsheet and any individual " & _
            "spreadsheets created and start again (change the name of the backup sheet created - by " & _
            "removing the '_backup2 and date' from the filename, correct the worksheet name error, save " & _
            "the workbook and run the macro again)."
        GoTo Endy
    End If
    MsgBox "Oops... VBA code error, number: " & Err & ", with a description of: " & Error(Err)
Endy:
End Sub