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

swarupa

New Member
Joined
Jan 2, 2021
Messages
31
Office Version
  1. 2010
Platform
  1. Windows
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.
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

GlennJ

New Member
Joined
Mar 26, 2018
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
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
VBA Code:
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

New Member
Joined
Jan 2, 2021
Messages
31
Office Version
  1. 2010
Platform
  1. Windows
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

New Member
Joined
Mar 26, 2018
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
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.
Code:
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

Board Regular
Joined
Apr 9, 2016
Messages
89
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

code from copy selected files save into another folder (using vba) (excelforum.com)- Thanks to sintek
VBA Code:
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
 
Solution

swarupa

New Member
Joined
Jan 2, 2021
Messages
31
Office Version
  1. 2010
Platform
  1. Windows
Thanku Thanku both of you AC PORTA VIA and GlennJ. Both of you great.
 

swarupa

New Member
Joined
Jan 2, 2021
Messages
31
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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

AC PORTA VIA

Board Regular
Joined
Apr 9, 2016
Messages
89
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Jan 2, 2021
Messages
31
Office Version
  1. 2010
Platform
  1. Windows
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

Board Regular
Joined
Apr 9, 2016
Messages
89
Office Version
  1. 365
Platform
  1. Windows
try this code
VBA 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
 

Watch MrExcel Video

Forum statistics

Threads
1,128,139
Messages
5,628,930
Members
416,354
Latest member
JojoMaque

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top