How to Copy excel files from subfolder to another destination folder?

[swarupa]

I am new in VBA Code. My question is :

I have one folder A. In this A Folder having thousands of subfolders with different name. These subfolders having some excel files. I want to copy these excel files to another folder name B but not at one time. First I want to open my main folder A and then I will select any one of the subfolder which I want and then copy all excel files to folder B from subfolder which I was selected.

 

[GlennJ]

I think you want to copy some of the Worksheets from Workbook A to a new Workbook B. This will copy all the Worksheets you have selected and put them in a new Workbook.

Change the line at the bottom of the code that starts with Wb.SaveAs to: where ever you want to save the new Workbook, select sheets to be copied and run macro.
Place this code in Workbook A

Sub CopySheets()

    Dim wb As Workbook
    Dim wks As Sheets
    Dim wsDest As Worksheet
    Dim wsSrc As Worksheet
    Dim rng As Range

     Set wks = ActiveWindow.SelectedSheets
       wks.Item(1).Select
        Set wb = Application.Workbooks.Add(xlWBATWorksheet)
    Set wsDest = wb.Worksheets(1)
    For Each wsSrc In wks
        wsDest.Name = wsSrc.Name
        Set rng = wsSrc.UsedRange
        rng.Copy

        With wsDest.Cells(rng.Row, rng.Column) ' Used Range might not start at A1
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats      ' optional, if required
            .PasteSpecial xlPasteColumnWidths ' optional, if required
            .Cells.FormatConditions.Delete    ' optional, if CF is not required

        End With   

        If Not wsSrc Is wks.Item(wks.Count) Then
            Set wsDest = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))

        End If

    Next

    

'Change next line to where you want the Workbook saved

    wb.SaveAs "C:\Your\Path\To\YourFileName.xlsx", xlWorkbookDefault ' or other format
    

End Sub

 

[swarupa]

I want to copy all excel files (not sheets) from any source Folder and copy it to destination folder B.

But when code run I want to choose the source folder or any subfolder.

 

[GlennJ]

Here's some code I found on here by GWteB. His or her macro copies all excel files from one folder to another folder. You would need to change the source folders and destination folders to what ever you want.

Public Sub CopyFiles_r2()

    Dim sPathSource As String, sPathDest As String, sFileSpec As String

    sPathSource = "C:\Your\Source\Folder\Path\test"
    sPathDest = "C:\Your\Destination\Folder\Path\test2"

    sFileSpec = "*.xlsx"
    'sFileSpec = "*example*2020.xl*"
    'sFileSpec = "*.pdf"

    Call CopyFiles_FromFolderAndSubFolders(sFileSpec, sPathSource, sPathDest)
End Sub


Public Sub CopyFiles_FromFolderAndSubFolders(ByVal argFileSpec As String, ByVal argSourcePath As String, ByRef argDestinationPath As String)

    Dim sPathSource As String, sPathDest As String, sFileSpec As String

    Dim FSO         As Object
    Dim oRoot       As Object
    Dim oFile       As Object
    Dim oFolder     As Object

    sPathSource = argSourcePath
    sPathDest = argDestinationPath

    If Not Right(sPathDest, 1) = "\" Then sPathDest = sPathDest & "\"
    If Right(sPathSource, 1) = "\" Then sPathSource = Left(sPathSource, Len(sPathSource) - 1)

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(sPathSource) And FSO.FolderExists(sPathDest) Then
        Set oRoot = FSO.GetFolder(sPathSource)
        For Each oFile In oRoot.Files
            If LCase(oFile.Name) Like argFileSpec Then
                On Error Resume Next
                oFile.copy sPathDest & oFile.Name
                On Error GoTo 0
            End If
        Next oFile
        For Each oFolder In oRoot.SubFolders
            ' == do the same for any folder ==
            Call CopyFiles_FromFolderAndSubFolders(argFileSpec, oFolder.Path, sPathDest)
        Next oFolder
    End If
End Sub

 

[AC PORTA VIA]

code from copy selected files save into another folder (using vba) (excelforum.com)- Thanks to sintek

Option Explicit
Sub Copy_Certain_Files_In_Folder()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim Path1 As String, Path2 As String
Dim numTimes As Integer
For numTimes = 1 To 1 'Change 2 to number of times you want to do the procedure.....
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            Path1 = .SelectedItems(1)
        End If
    End With
        If Path1 <> "" Then
            FromPath = Path1
        End If
       
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = -1 Then
                Path2 = .SelectedItems(1)
            End If
        End With
        If Path2 <> "" Then
            ToPath = Path2
        End If
        FileExt = "*.xl*"
       
        If Right(FromPath, 1) <> "\" Then
            FromPath = FromPath & "\"
        End If
   
        Set FSO = CreateObject("scripting.filesystemobject")
        If FSO.FolderExists(FromPath) = False Then
            MsgBox FromPath & "Doesn't exist"
            Exit Sub
        End If
   
        If FSO.FolderExists(ToPath) = False Then
            MsgBox ToPath & "Doesn't exist"
            Exit Sub
        End If
   
        FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
        MsgBox "You can find the files from " & FromPath & " in " & ToPath
Next 'numTimes
End Sub

 

[swarupa]

Thanku Thanku both of you AC PORTA VIA and GlennJ. Both of you great.

 

[swarupa]

How I Can move particular excel file by selecting one source folder or subfolder to by selecting destination folder?

 

[AC PORTA VIA]

no sure i understand your last question
you want to move ( or copy) one particular file to folder by selecting destination folder? is that correct

 

[swarupa]

I want to move not copy one particular excel file to folder by selecting destination folder.
For that i was use your previous code and then
Kill ("C:\Users\S\Desktop\C\*A.xls")

 

[AC PORTA VIA]

try this code

Option Explicit
Sub SaveExcelFilePrompt()

Application.ScreenUpdating = False

Dim SaveDialogBox As Object
Dim OutputFolder As String

Workbooks.Open Filename:="your file path" '"C:\Users\S\Desktop\C\*A.xls"

'''''Select output folder where output files will be saved
Set SaveDialogBox = Application.FileDialog(msoFileDialogFolderPicker)

If SaveDialogBox.Show = -1 Then
OutputFolder = SaveDialogBox.SelectedItems(1)
End If
'''''Saving this select  file in output folder
ActiveWorkbook.SaveCopyAs Filename:=OutputFolder & "\" & ActiveWorkbook.Name
ActiveWorkbook.Close
Kill ("your file path") 'Kill ("C:\Users\S\Desktop\C\*A.xls")

Application.ScreenUpdating = True

End Sub