【VBA】マクロファイルが置かれているディレクトリにある全xlsxファイルから、任意のシートをコピーしたい

■作る機能

このマクロファイルが置かれているディレクトリに置かれているファイル（この膜rファイル自身は含まない）から、指定のシート名のシートをコピーしてくる。

■作るための方法

ループの方法

特定のフォルダにあるファイル数分処理をしたいので、ループ処理が必要。VBAのループはわからないので調べてみたところ、以下４つくらい方法がありそう。

使い分けとしては、すごく端折ると、簡単なループはシンプルにForで良いらしい（それかDo Loop）。今回のように、フォルダ内のファイル分だけ処理を繰り返すものは、Do While。ただそれも、Do Loopでも実装は可能ということ。

ちなみに最初、Do Whileでやってみたが、ファイル名がnullのファイルを開こうとしてしまうエラー（後述）にぶち当たったので、Do Loopに変更。Do　Whileはまだ早かったようだ・・ほかにもやりたいことがあるので、一旦Do Loopで実装が出来れば今回はよしとした。

• Do While
• Do Until
• Do Loop
• For

■完成コード

Sub SheetCopyVer4()
    Dim macroWb As Workbook
    
    Dim importWb As Workbook
    Dim importPath As String
    Dim SheetName As String
    Dim buf As String

    
    Set macroWb = ThisWorkbook
    SheetName = Range("A2").Value

    
    importPath = ThisWorkbook.Path
    buf = Dir(importPath & "\*")
    
    Do
        If ThisWorkbook.Name <> buf Then
        End If
             buf = Dir()
             If buf = "" Then Exit Do
             MsgBox buf
             Set importWb = Workbooks.Open(importPath & "\" & buf)
             importWb.Worksheets(SheetName).Copy After:=macroWb.Worksheets("Sheet0")
             importWb.Close        
    Loop
End Sub

■つまずいた箇所

ファイル名　=　””の時は処理を抜けるように書いたつもりなのに抜けられておらず、ファイル名が””のファイルを開こうとして落ちてしまう。

■原因

Exitの位置。

正：

   Do         
             If buf = "" Then Exit Do
             MsgBox buf
             Set importWb = Workbooks.Open(importPath & "\" & buf)
             importWb.Worksheets(SheetName).Copy After:=macroWb.Worksheets("Sheet0")
             importWb.Close

　　　 buf = Dir()

    Loop
End Sub

誤：これだと、ファイル名（bufが空白の場合も、Workbooks.Open処理を走らせてしまいエラーになる）

   Do
             MsgBox buf
             Set importWb = Workbooks.Open(importPath & "\" & buf)
             importWb.Worksheets(SheetName).Copy After:=macroWb.Worksheets("Sheet0")
             importWb.Close
　 　　buf = Dir()

　　     If buf = "" Then Exit Do
    Loop
End Sub

品質保証は未実施・・バグはあるかもだが、力尽きたので今日はここまで。