Sub Copyfiles()

    ' Updateby Extendoffice

    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    Dim FSO As Object, folder1 As Object

    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)

    If xRg Is Nothing Then Exit Sub

    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = " Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & ""

    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = " Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & ""

    Call sCopyFiles(xRg, xSPathStr, xDPathStr)

End Sub

Sub sCopyFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
    Dim xCell As Range
    Dim xVal As String
    Dim xMainFolder As String
    Dim xSubFolder As String
    Dim FSO As Object
    Dim xI As Integer

    If Dir(xDPathStr, vbDirectory) = "" Then
        MkDir (xDPathStr)
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    For xI = 1 To xRg.Count
        Set xCell = xRg.Item(xI)
        xVal = xCell.Value
        xMainFolder = xCell.Offset(0, 1).Value ' Column B for main folder
        xSubFolder = xCell.Offset(0, 2).Value ' Column C for subfolder

        If xMainFolder <> "" Then
            xMainFolder = xDPathStr & xMainFolder & ""
            If Dir(xMainFolder, vbDirectory) = "" Then
                MkDir (xMainFolder)
            End If

            If xSubFolder <> "" Then
                If TypeName(xVal) = "String" And Not (xVal = "") Then
                    On Error GoTo E1
                    If Dir(xSPathStr & xVal, 16) <> Empty Then
                        ' Delete any existing subfolder or file with the same name in the destination folder
                        If Dir(xDPathStr & xSubFolder, vbDirectory) <> "" Then
                            FSO.DeleteFolder xDPathStr & xSubFolder, True
                        ElseIf Dir(xDPathStr & xVal, vbNormal) <> "" Then
                            FSO.DeleteFile xDPathStr & xVal, True
                        End If
                        
                        ' Create the subfolder inside the main folder
                        If Dir(xMainFolder & xSubFolder, vbDirectory) = "" Then
                            MkDir (xMainFolder & xSubFolder)
                        End If
                        
                        ' Copy the file to the subfolder inside the main folder
                        FileCopy xSPathStr & xVal, xMainFolder & xSubFolder & "" & xVal
                    End If
                End If
            Else
                If TypeName(xVal) = "String" And Not (xVal = "") Then
                    On Error GoTo E1
                    If Dir(xSPathStr & xVal, 16) <> Empty Then
                        ' Delete any existing file with the same name in the destination folder
                        If Dir(xDPathStr & xVal, vbNormal) <> "" Then
                            FSO.DeleteFile xDPathStr & xVal, True
                        End If
                        
                        ' Copy the file to the main folder
                        FileCopy xSPathStr & xVal, xMainFolder & xVal
                    End If
                End If
            End If
        Else
            ' If there is no main folder, place the file directly in the destination folder
            If TypeName(xVal) = "String" And Not (xVal = "") Then
                On Error GoTo E1
                If Dir(xSPathStr & xVal, 16) <> Empty Then
                    ' Delete any existing file with the same name in the destination folder
                    If Dir(xDPathStr & xVal, vbNormal) <> "" Then
                        FSO.DeleteFile xDPathStr & xVal, True
                    End If
                    
                    ' Copy the file to the destination folder
                    FileCopy xSPathStr & xVal, xDPathStr & xVal
                End If
            End If
        End If

E1:
    Next xI
End Sub

the code should basically take files from the source folder and put it in the a folder or subfolder. for example as you see the image 27256l shold go in the subfolder called woman pants inside the main folder called woman, and the other picture should just be in the main folder. it does the selecting and picking correctly however it creates an extra subfolder called woman pants outside the main folder location, and I’m unable to fix the issue.