In the VBA code below, every thing works perfectly up to the point where I have placed the comment ' CODE WORKS ACCURATELY UP TO THIS POINT. After this point, I can not get the code to copy the 'fileFound' to the destinationFolder. : Option Explicit

Sub MoveFileQuote(ByVal TargetCell As Range)
    Dim folderPath As String
    Dim fileNamePattern As String
    Dim destinationFolder As String
    Dim fileName As String
    Dim fileFound As Boolean
    Dim objShell As Object
    Dim objExplorer As Object
    Dim obj As Object

    ' Define source and destination folders
    folderPath = ThisWorkbook.Path & "\" & "z Quotes On Hold"
    destinationFolder = ThisWorkbook.Path & "\" & TargetCell.Offset(0, -4).Value
    
    Set objShell = CreateObject("Shell.Application")
    Set objExplorer = objShell.Windows

    ' Open the source folder in Windows Explorer and confirm
    Shell "explorer.exe " & folderPath, vbNormalFocus
    Application.Wait (Now + TimeValue("0:00:02"))
    Dim confirmSource As VbMsgBoxResult
    confirmSource = MsgBox("Is the source folder correct?", vbYesNo + vbQuestion)

    ' If source folder is incorrect, exit the code
    If confirmSource = vbNo Then
        MsgBox "Please verify the source folder and run the code again.", vbInformation, "SOURCE"
        Exit Sub
    End If
    
    ' Open the destination folder in Windows Explorer and confirm
    Shell "explorer.exe " & destinationFolder, vbNormalFocus
    Application.Wait (Now + TimeValue("0:00:02"))
    Dim confirmDest As VbMsgBoxResult
    confirmDest = MsgBox("Is the destination folder correct?", vbYesNo + vbQuestion)

    ' If destination folder correct, proceed with file processing
    If confirmDest = vbNo Then
        MsgBox "Please verify the destination folder and run the code again.", vbInformation, "DESTINATION"
        Exit Sub
    End If
    
    fileNamePattern = "Quote " & TargetCell.Value & "*"
    fileFound = False
    
    Dim fso As Object
    Dim objFile As Object
    ' Display files found in the folder that match the fileNamePattern
    Dim filesFound As String

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso Is Nothing Then
    For Each objFile In fso.GetFolder(folderPath).files
        If InStr(1, objFile.Name, TargetCell.Value, vbTextCompare) > 0 Then
            filesFound = filesFound & vbCrLf & objFile.Name
            fileFound = True
        End If
    Next objFile

    If fileFound Then
        MsgBox "Files found in the folder that match the pattern:" & vbCrLf & filesFound
    Else
        MsgBox "No files found in the folder that match the pattern."
    End If
    Exit Sub
    
' CODE WORKS ACCURATELY UP TO THIS POINT
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'If fso.FolderExists(folderPath) And fso.FolderExists(destinationFolder) Then
        'fso.CopyFile folderPath & "\" & fileNamePattern, destinationFolder, True  ' Use wildcard and overwrite existing files (True)
        fso.CopyFile folderPath & "\" & fileFound, destinationFolder
  MsgBox fileFound & " moved successfully."
  'fileFound = True
If Error Then
     MsgBox "A file with the same name already exists in the destination folder."
                End If
            End If
End Sub