使用方法の確認

いったんメモ
使い方の確認です。

取り消し線

ファイル・フォルダコピーマクロ

    Dim Original_folderPath As String
    Dim Clone_folderPath As String
    Dim LastRow As Long
    Dim i As Long
    Dim Target_fileList As Collection
    Dim Target_file As String

    Set Target_fileList = New Collection

    Original_folderPath = Worksheets("フォルダ").Cells(3, 1).Value
    Clone_folderPath = Worksheets("フォルダ").Cells(6, 1).Value

    If Right(Original_folderPath, 1) <> "\" Then Original_folderPath = Original_folderPath & "\"
    If Right(Clone_folderPath, 1) <> "\" Then Clone_folderPath = Clone_folderPath & "\"

    LastRow = Worksheets("フォルダ").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 9 To LastRow
        Target_file = Trim(Worksheets("フォルダ").Cells(i, 1).Value)
        If Target_file <> "" Then Target_fileList.Add Target_file
    Next i

    ' 再帰的にファイル探索とコピー
    Call SearchAndCopyFiles(Original_folderPath, Clone_folderPath, Target_fileList, Original_folderPath)

    MsgBox "コピーが完了しました。", vbInformation
End Sub

Sub SearchAndCopyFiles(ByVal currentFolder As String, ByVal Clone_folderPath As String, _
                       ByVal Target_fileList As Collection, ByVal Root_folder As String)

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim file As Object
    Dim subfolder As Object
    Dim targetName As Variant

    ' このフォルダ内のすべてのファイルをチェック
    For Each file In fso.GetFolder(currentFolder).Files
        For Each targetName In Target_fileList
            If StrComp(file.Name, targetName, vbTextCompare) = 0 Then
                ' 相対パスを作ってコピー先を決定
                Dim relativePath As String
                relativePath = Mid(file.ParentFolder.path, Len(Root_folder) + 1)
                If relativePath <> "" Then relativePath = relativePath & "\"

                Dim destPath As String
                destPath = Clone_folderPath & relativePath

                If Not fso.FolderExists(destPath) Then fso.CreateFolder destPath
                file.Copy destPath & file.Name, True
            End If
        Next targetName
    Next file

    ' サブフォルダについても同様に処理（再帰）
    For Each subfolder In fso.GetFolder(currentFolder).SubFolders
        Call SearchAndCopyFiles(subfolder.path, Clone_folderPath, Target_fileList, Root_folder)
    Next subfolder
End Sub