[[20220418232124]]　『階層の違うブックからシートをコピーしたい』（メガネ）　ページの最後に飛ぶ

『階層の違うブックからシートをコピーしたい』（メガネ）

C:\Users\●●\Desktop\〇〇\結果に入ってるブックでマクロを実行し

C:\Users\●●\Desktop\〇〇\部品単価に入っている価格表のシートを
マクロを実行したブックの最後のシートに追加したいのですが

  importWb.Worksheets("りすと").Copy After:=macroWb.Worksheets(macroWb.Worksheets.Count)

上記の部分でエラーが出てしまいます。
なんでエラーになるのかわからないので、教えていただけないでしょうか？
よろしくお願いします。

Sub リスト転記()

    Dim ws As Worksheet

    ' メッセージを非表示
    Application.DisplayAlerts = False

    ' 一覧シートがあるか確認あったら削除
    For Each ws In Worksheets
      If ws.Name = "りすと" Then
        ws.Delete
      End If
    Next ws

    ' メッセージを表示
    Application.DisplayAlerts = True

    Dim FolderPath, FilePath, FileName

    'フォルダパスを指定
    FolderPath = ThisWorkbook.Path & "\..\部品単価"
    'フォルダ内のファイル名を取得
    FileName = Dir(FolderPath & "\*")
    'ファイルパスを作成
    FilePath = FolderPath & "\" & FileName

    'ファイルを開く
    Workbooks.Open FileName:=FilePath

    'インポート先
    Dim importWb As Workbook
    Dim importPath As String

    'マクロを実行元のWorkbook
    Set macroWb = ThisWorkbook

    'インポート先の文字列を取得
    importPath = FilePath

    'データをインポート(シートの内容をコピー)
    Set importWb = Workbooks.Open(importPath)
    importWb.Worksheets("りすと").Copy After:=macroWb.Worksheets(macroWb.Worksheets.Count) 'Afterの場合、指定したシートの後ろに
    importWb.Close

End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

こうしたエラー解決の質問では、エラーメッセージを省略せずに書いてください。
重要な手掛かりを隠してはいけません。
（想像することはありますが、質問者さんが明示するのが筋なので。）

そのほかの気づき。
・同じファイルを二回開いていますが、意図したものですか？
・宣言していない変数(macroWb)があります。きちんと宣言したほうが安全です。
　モジュールの冒頭に、Option Explicitを書いてください。
　VBEのオプション設定で「変数宣言を強制する」にチェックを入れると、
　モジュールが作成されたときに、自動でそれを挿入してくれます。
　（生涯で一度、設定を実行するだけです。推奨します。）
・コメントが多すぎる印象。
　必要な情報が目立ちません。ほどほどがよいと思います。
　（老婆心なので気にしないでください。）

（γ） 2022/04/19(火) 06:41

ちょっと自信のない部分もありますが、何点か。

■１
↓は思うとおりのパスになってますか？

 FolderPath = ThisWorkbook.Path & "\..\部品単価"

[..\]とされているので、ThisWorkbook.Pathを起点に【相対的】にみたフォルダとされたいのだとおもいますが、上記だと↓のような文字列になっちゃいませんかね

 C:\Users\●●\Desktop\〇〇\結果\..\部品単価

もしも[..\]を使いたいなら、↓のように先にカレントディレクトリを変えないとダメじゃないかなとおもいます。

 ChDir ThisWorkbook.Path
 FolderPath = "..\部品単価"

 ※相対パスは自信がないので、他の回答さんの意見を聞いたり↓を参照いただいたほうが良いと思います。
[[20181228220926]]　『絶対パスではなく相対パスを取得する。』（アイス）

なお、絶対パスでよいのであれば、以下のように普通に文字列操作すればよいですね。

 (1)「ThisWorkbook.Path」で↓を調べる（取得する）
       C:\Users\●●\Desktop\〇〇\結果

 (2)(1)で取得した文字列を右から見て始めて"\"が出てくるのは全体の何文字目かInStrRev関数で調べる
       InStrRev("C:\Users\●●\Desktop\〇〇\結果","\")

 (3)Left関数を使って、(1)の文字列から(2)文字目までを取り出す
       Left("C:\Users\●●\Desktop\〇〇\結果", InStrRev("C:\Users\●●\Desktop\〇〇\結果", "\"))

 (4)(3)と"部品単価"を合体させる
       Left("C:\Users\●●\Desktop\〇〇\結果", InStrRev("C:\Users\●●\Desktop\〇〇\結果", "\")) & "部品単価"

■２
「りすと」シートがあれば削除する部分ですが↓のようにする方法もあるとおもいます。

    On Error Resume Next
    ThisWorkbook.Worksheets("りすと").Delete
    On Error GoTo 0

ただ、シートを"削除"するべきなのかは一旦再考した方がよろしいのではないでしょうか？
＞価格表のシートをマクロを実行したブックの最後のシート
ということは、価格表を【更新】したいのですよね？
仮に、その価格表を参照するような数式を組んでいた場合、シートを削除した段階で参照が切れてしまいます。

 ※INDIRECT関数を使ってあるなどであれば別ですが

なので【更新】であれば、"クリア"してコピペというアプローチのほうが良いように思います。

■３
↓の部分について、ダメではないですが

 Dim FolderPath, FilePath, FileName

慣れてきたら↓のように型も指定するようにすると良いですね。

 Dim FolderPath As String, FilePath As String, FileName As String

■４
↓について、おそらくExcelブックを対象にした処理だとおもいますので、

 FileName = Dir(FolderPath & "\*")

↓のように、Excelブックに限定したほうが安パイでしょう

 FileName = Dir(FolderPath & "\*.xls?")

 ※指定のフォルダに１つしかファイルを保存しないというルールなら問題無いですが、そうで無い場合
   「\*」だと関係ない（Excelブック以外の）ファイルもヒットしちゃいます。

更に言うと、そもそも【ブック名】は固定されていていたりしませんか？その場合、Dir関数で"探す"必要がそもそもないですよね。

 ※ブックが度々更新されるのでファイル名が決まってないということなら、"探す"必要があるのはわかりますが、
   そうなると該当するファイル（Excelブック）が複数あった場合どうするのかということも少々心配です。

■５
既に指摘がありますが↓は同じブックを２回開くことになりますよ。

 Workbooks.Open FileName:=FilePath
 Set importWb = Workbooks.Open(importPath)

■６
変数の宣言が無いと指摘されている↓ですが、そもそも変数に入れる必要あるんでしょうか？

 Set macroWb = ThisWorkbook

"ThisWorkbook"と書けばそれでおしまいですが・・・

■７
というようなことを踏まえて整理すると↓のような感じになろうかと思います。
興味があれば【ステップ実行】して研究してみてください。

    Option Explicit
    Sub 研究用()
        Dim フォルダパス As String
        Dim ファイル名 As String
        Dim srcWB As Workbook

        With ThisWorkbook

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

            '■２参照
            Application.DisplayAlerts = False
            On Error Resume Next
            .Worksheets("りすと").Delete
            On Error GoTo 0
            Application.DisplayAlerts = True

            フォルダパス = Left(.Path, InStrRev(.Path, "\")) & "部品単価"

            '■４参照
            ファイル名 = Dir(フォルダパス & "\*.xls?")

            Set srcWB = Workbooks.Open(フォルダパス & "\" & ファイル名)

            '■２参照
            srcWB.Worksheets("りすと").Copy After:=.Worksheets(.Worksheets.Count)

            srcWB.Close False
        End With
    End Sub

（もこな２） 2022/04/19(火) 23:09

Sub test()

    Const cWshName As String = "りすと"
    Dim sFName As String
    Dim sMyPath As String
    Dim wbkTarget As Workbook
    Dim wsh As Worksheet

    sMyPath = Replace(ThisWorkbook.Path, "結果", "部品単価")
    sFName = Dir(sMyPath & "\*")
    If Len(sFName) = 0 Then Exit Sub
    Set wbkTarget = Workbooks.Open(sMyPath & "\" & sFName)
    On Error Resume Next
    Set wsh = wbkTarget.Worksheets(cWshName)
    On Error GoTo 0

    If wsh Is Nothing Then
        MsgBox "「リスト」シートが見つかりません。"
    Else
        On Error Resume Next
        ThisWorkbook.Worksheets(cWshName).Delete
        On Error GoTo 0
        wsh.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    End If

    wbkTarget.Close False
End Sub

作業の手順を再考してみては？

（まっつわん） 2022/04/20(水) 13:28

コメント返信：

[ 一覧(最新更新順) ]

[[20220418232124]] 『階層の違うブックからシートをコピーしたい』（メガネ） ページの最後に飛ぶ

[[20220418232124]]　『階層の違うブックからシートをコピーしたい』（メガネ）　ページの最後に飛ぶ