Copy a file if it exists

Sub CopyFile()

Dim fso
Dim file As String, sfol As String, dfol As String

file = "test.xls" ' change to match the file name
sfol = "C:\" ' change to match the source folder path
dfol = "E:\" ' change to match the destination folder path

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FileExists(sfol & file) Then

MsgBox sfol & file & " does not exist!", vbExclamation, "Source File Missing"

ElseIf Not fso.FileExists(dfol & file) Then

fso.CopyFile (sfol & file), dfol, True

Else

MsgBox dfol & file & " already exists!", vbExclamation, "Destination File Exists"

End If

End Su

Check if a file exists

Sub FileExists()
Dim fso
Dim file As String

file = "C:\Test.xls"
Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FileExists(file) Then
     MsgBox file & " was not located.", vbInformation, "File Not Found"
       Else
     MsgBox file & " has been located.", vbInformation, "File Found"
End If

End Sub

Consolidate Sub-Folder files with a click

Consolidate Sub-Folder files with a click (condition: where file name match with the master file sheets name)

Sub Conslolidate_subFiles()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim fso As FileSystemObject
Dim Myfl As Folder
Dim Msubf As Folder
Dim fl As File
Dim Fpath As String
Dim Fname As String
Dim RowCount As Double
Dim wkb As ThisWorkbook
Dim sh As Worksheet

Set wkb = Workbooks("Jai_Shri_Ganesh")
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
Fpath = .SelectedItems(1)
End With
Set fso = New FileSystemObject
Set Myfl = fso.GetFolder(Fpath)
    For Each Msubf In Myfl.SubFolders
        For Each fl In Msubf.Files
            Workbooks.Open (fl.Path)
            Sheets("Packing Slip").Activate
            RowCount = Sheets("Packing Slip").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Packing Slip").Range("a23: h" & RowCount).Copy
            wkb.Activate
            For Each sh In wkb.Sheets
            If VBA.Mid(Right(fl.Name, 9), 1, 2) = VBA.Right(sh.Name, 2) Then
            wkb.Sheets(sh.Name).Activate
            RowCount = wkb.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Row
            Sheets(sh.Name).Cells(RowCount + 1, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            ActiveWorkbook.Save
            End If
            Next sh
            Workbooks(fl.Name).Activate
            ActiveWorkbook.Close
            wkb.Save
        Next fl
    Next Msubf
End Sub

Create a folder if it doesn't exist

Sub CreateFolder()

Dim fso

Dim fol As String

fol = "c:\MyFolder" ' change to match the folder path

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(fol) Then

fso.CreateFolder (fol)

Else

MsgBox fol & " already exists!", vbExclamation, "Folder Exists"

End If

End Sub