他ブックからのシートコピーのマクロ

質問

マクロ初心者です。
下記マクロを完成する事が出来たのですが、一部修正がうまくいかない為投稿させていただきました。

マクロ内容：エクセルファイルを指定し、選択したシートを現在のブックにコピーする
その際、不要な名前管理を削除してからコピー

修正したい箇所：指定したブックからコピーした際、シート参照の数式が入っていると外部参照になってしまう。

やってみた事：(1)(i)の前にarrayを入れる→外部参照のまま
(2)(i)を削除してみた→外部参照にならなくたったが際限なくシートをコピーし続けた

Sub 名前管理削除()
Dim myPath As String
Dim wb_A As Workbook
Dim i As Integer
'
myPath = Application.GetOpenFilename(("Excelファイル,*.xls*,CSVファイル,*.csv"), , "ブックを選択して下さい。")
If myPath = "False" Then Exit Sub
Set wb_A = Workbooks.Open(myPath)
Dim name As Object

For Each name In Names
If name.Visible = False Then
name.Visible = True
End If
Next
On Error Resume Next ' エラーを無視。(削除件数にカウントしてしまいます)
For Each nm In ActiveWorkbook.Names
If InStr(nm.Value, "#REF") > 0 Or _
InStr(nm.Value, "\") > 0 Then
nm.Delete
i = i + 1
Else

End If
Next nm
' 終了の表示
MsgBox "不要な名前定義を削除しました。" & vbCr & _
"削除定義件数=" & i & "件", vbInformation, cnsTitle
For i = 1 To wb_A.Sheets.Count
wb_A.Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next
wb_A.Close False
End Sub

不勉強で申し訳ございませんが、何卒よろしくお願いいたします。

回答No.1

HohoPapa · ベストアンサー

>やってみた事：(1)(i)の前にarrayを入れる
複写元のシートたちを配列変数に格納するだけでは不十分で
それらを作業グループとして選択状態にする必要があるようです。

こんなコードです。

Sub test()

　Dim FBook As Workbook
　Dim TBook As Workbook
　Dim Sh As Worksheet
　Dim ArrayShName() As String
　Dim i As Long

　Set FBook = Workbooks.Open(ThisWorkbook.Path & "\元.xlsx")
　Set TBook = Workbooks.Open(ThisWorkbook.Path & "\先.xlsx")

　FBook.Activate
　ReDim ArrayShName(0)
　For Each Sh In FBook.Worksheets
　　ReDim Preserve ArrayShName(i)
　　ArrayShName(i) = Sh.Name
　　i = i + 1
　Next Sh
　Worksheets(ArrayShName).Select

　FBook.Sheets(ArrayShName).Copy _
　　　After:=TBook.Sheets(TBook.Sheets.Count)

End Sub