[[20230105145102]]　『別ブックにシートコピー』（りおりお）　ページの最後に飛ぶ

『別ブックにシートコピー』（りおりお）

ダイアログで指定した別ブックにシート名：データをコピーしたいのですが下記マクロで「インデックスが有効範囲にありません」とエラーになりできません。解決方法を教えてください。

Sub 別ブックの先頭にコピーする()

  Dim FileName As Variant
    FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")
    If FileName = False Then
        Exit Sub
    End If   
  ThisWorkbook.Worksheets("データ").Copy _
      Before:=Workbooks(FileName).Worksheets(1)
End Sub

＜使用 Excel：Microsoft365、使用 OS：Windows11 ＞

 ブックを開いていないからだと思うよ
 ただ、これだと読み取り専用で開いていた場合とか、すでにブックを開いていた場合のエラー処理がないから、いろんな人が使う場合はもう少し工夫必要かも
    Sub 別ブックの先頭にコピーする()
        Dim FileName As Variant
        Dim WB As Workbook '★
        FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")
        If FileName = False Then
            Exit Sub
        End If
        Set WB = Workbooks.Open(FileName) '★
        ThisWorkbook.Worksheets("データ").Copy _
        Before:=WB.Worksheets(1) '★
    End Sub
（稲葉） 2023/01/05(木) 15:22:39

稲葉さん　たすかりました！
Set　して　Open するのですね　ありがとうございます。
（りおりお） 2023/01/05(木) 15:51:06

 その勢いは好きですが、若干不安覚えるお礼いただいたので補足を・・・

 WBっていう箱の中に、開いたワークブックを入れておくイメージです。
 「箱に入れる」という命令がSetなので、「SetしてOpen」ではなく、「OpenしてSet」のほうがニュアンスとして近いかも・・・

 最初の頃ってSetとかオブジェクトとか難しいですよね。
 ブックとかシートの処理って、やりたい処理よりエラー処理のほうが長くなるので参考までにエラー出たときに見直してみてください。
    Sub 別ブックの先頭にコピーする()
        Dim FileName As Variant
        Dim WB As Workbook '★
        Dim コピーシート名 As String
        コピーシート名 = "データ"

        'コピー先ブックの選択
        FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")
        If FileName = False Then
            MsgBox "ファイルが選択されなかったため、処理を中断します"
            Exit Sub
        End If

        '指定したブックが開かれているかチェックし、開かれていなければ開く
        On Error Resume Next
            Set WB = Workbooks(FileName)
        On Error GoTo 0
        If WB Is Nothing Then
            Set WB = Workbooks.Open(FileName) '★
        End If

        '読み取り専用かのチェック
        If WB.ReadOnly = True Then
            If MsgBox("ブックは読み取り専用です。処理を続けますか？", vbYesNo) <> vbYes Then
                MsgBox "処理を中断しました"
                Exit Sub
            End If
        End If

        '開いたブックに同じシート名があるかチェック
        WB.Activate
        If Application.Evaluate("ISREF('" & コピーシート名 & "'!A1)") = True Then
            MsgBox "すでに同じシートがあります。処理を中断します"
            Exit Sub
        End If

        '実際の処理
        ThisWorkbook.Worksheets(コピーシート名).Copy _
        Before:=WB.Worksheets(1) '★
        MsgBox "処理が完了しました"
    End Sub
（稲葉） 2023/01/05(木) 16:06:53

もう見ていないと思いますが何点か。
既に必要なアドバイスは得られていると思いますが、直接的な原因は「挿入される側のブックが正しく指定できていなかった」ことだと思われます。

■１
少し誤解されていた部分があるとおもいますが、↓はブックを開く命令ではありません。

 FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")

上記では[FileName]にダイアログで選択したファイルのフルパス（文字列）が格納されるだけです。
よって、実際に操作対象にするのであれば、別途開く必要があります。

■２
おそらく、問題が発生した時点では指摘があるようにブックが開かれていなかったのだとおもいますが、ブックが開かれていたとしても↓だと問題があります。

 ～～ Before:=Workbooks(FileName).Worksheets(1)

すなわち「■１」で述べたように「FileName」にはフォルダを含めたフルパスが格納されていますから、例えば【C:\work】というフォルダにある【hoge.xls】というブックを指定したら↓のようになります。
　～Before:=Workbooks("C:\work\hoge.xls").Worksheets(1)

これを踏まえて↓を実行してみるとわかりますが、仮に対象のブックを事前に開くようにしていたとしてもエラーになります。

    Sub 実験()
        Dim ファイルパス As String
        Dim WB As Workbook

        ファイルパス = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")
        Workbooks.Open (ファイルパス) '←ここで開いても
        Set WB = Workbooks(ファイルパス) '←ここでフルパスをブック名にしているためエラー
        MsgBox WB.Name
    End Sub

つまり、「インデックスが有効範囲にありません」というエラーは、「そんな(C:\work\hoge.xlsという）名前のブックがないよ！」とエクセル君から言われていた状態だったということです。

■３
＞Set　して　Open するのですね
既に理解できたかもしれませんが、問題点は冒頭に述べたように【挿入される側のブックの指定が正しくなかった】ことです。
したがって、変数に格納するというのは１つの方法という話であって

 (1)対象のブックを開く処理を追加する
 (2)【フルパス】から【ブック（ファイル）名】をとりだして、ちゃんとブック名で指定する

という点を修正すれば、↓のように当初のコードでもちゃんと動作したでしょう。

    Sub 研究用01()
        Dim FileName As Variant

        FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")
        If FileName = False Then
            Exit Sub
        Else
            '▼ブックを開く命令を追加
            Workbooks.Open FileName

            '▼Dir関数を使ってファイルパスからブック名を取り出すように修正
            ThisWorkbook.Worksheets("データ").Copy Before:=Workbooks(Dir(FileName)).Worksheets(1)
        End If
    End Sub

■４
以下は完全に蛇足ですが、「Application.GetOpenFilename」で指定したブックが既に開いているかどうかは↓では確認できません。（理由の１つは■２のとおり）

 FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")

 On Error Resume Next
 Set WB = Workbooks(FileName)  '←ここでフルパスを指定しているためSetに失敗する
 On Error GoTo 0

 If WB Is Nothing Then

そして、二つ目の理由が【ファイルパス】から【ファイル名】を取り出したとしても、同名のブックが開いているかどうかの確認しかできません。

 (すでに開いているブックが、別フォルダの同名ブックである可能性があります）

なので、個人的はあれこれ悩むよりも↓のように、同名ブックが開いていれば閉じてからやり直させるというアプローチのほうがいいんじゃないかと思います。 (自分しか使わないならどちらでもよいでしょうが）

    Sub 研究用02()
        Dim ファイルパス As String, ファイル名 As String
        Dim WB As Workbook

        ファイルパス = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")
        ファイル名 = Split(ファイルパス, "\")(UBound(Split(ファイルパス, "\")))

        Stop 'ブレークポイントの代わり

        If ファイルパス = "" Then
            MsgBox "ブックが指定されませんでした" & vbLf & "処理を中止します"
            Exit Sub
        End If

        On Error Resume Next
        Set WB = Workbooks(ファイル名)
        On Error GoTo 0

        If Not WB Is Nothing Then
            MsgBox "既に【" & WB.Name & "】が開かれています。" & vbLf & "該当ブックを閉じてからやり直してください"
            Exit Sub
        End If

        With Workbooks.Open(ファイルパス)
            ThisWorkbook.Worksheets("データ").Copy Before:=.Worksheets(1)  '開いたブックの１番目のシートの前にコピー挿入しなさい
            .SaveAs .Path & "\【済】" & .Name '（ブックを）(同じフォルダに)別名で保存しなさい
            .Close False '（ブックを）閉じなさい
        End With
    End Sub

なお、読み取り専用でブックが開かれていたとしても別名であれば保存できますし、コピー挿入であればシート名が被ってもエクセル君が適宜処理してくれますますので、その辺はご自身で具合の良いように調整されるとよいとおもいます。

（もこな２） 2023/01/10(火) 12:26:27

コメント返信：

[ 一覧(最新更新順) ]

[[20230105145102]] 『別ブックにシートコピー』（りおりお） ページの最後に飛ぶ

[[20230105145102]]　『別ブックにシートコピー』（りおりお）　ページの最後に飛ぶ