VBA if file not found create and paste data

Question

I hope you can help. I have a piece of code see CODE 1 (my code in its entirety) and essentially what it does is allows a user to navigate through folders, select a file. Once selected, it separates the workbook based on the criteria (country) in Column A into new worksheets, renames the new worksheets after the countries and adds some text. All this works fine.

The issue I am facing is that when the Workbook is split into different sheets. See Pic 1, I then need to copy and paste specific country sheets into workbooks already stored in another folder. See Pic 2. The code I have works fine if the workbook already exists in the folder (in my example Germany) but if the workbook is not present (Belgium) I need the code to create a new workbook for that country and then paste the data into the new workbook.

So in Pic 2 you can see that Germany is present in folder H:\TOV Storage Folder and the copy and paste code see CODE 2 works fine

CODE 2

If s.Name = "DE_ITOV_MTNG_ATNDEE.xlsx" Then

            s.Activate
            ActiveSheet.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy
            Set y = Workbooks.Open("H:\TOV Storage Folder\Germany.xlsx")
            y.Sheets(2).Name = "DE_ITOV_MTNG_ATNDEE"
            y.Sheets("DE_ITOV_MTNG_ATNDEE").Range("A1").PasteSpecial Paste:=xlPasteFormulas
            y.SaveAs "H:\TOV Storage Folder\Germany.xlsx"
            y.Close

But Belgium does not exist in folder H:\TOV Storage Folder so CODE 3 throws back an error saying cannot find Belgium in H:\TOV Storage Folder and the macro stops

CODE 3

ElseIf s.Name = "BE_ITOV_MTNG_ATNDEE.xlsx" Then
            s.Activate
            ActiveSheet.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy
            Set y_1 = Workbooks.Open("H:\TOV Storage Folder\Belgium.xlsx")
            y_1.Sheets(2).Name = "BE_ITOV_MTNG_ATNDEE"
            y_1.Sheets("BE_ITOV_MTNG_ATNDEE").Range("A1").PasteSpecial Paste:=xlPasteFormulas
            y_1.SaveAs "H:\TOV Storage Folder\Belgium.xlsx"
            y_1.Close

Essentially what I need to happen is for the workbook to split in to its country sheets then for the macro to start moving through the sheets if it finds a country sheet that has a corresponding workbook present in H:\TOV Storage Folder then perform the copy and paste, if it finds a sheet in the split workbook that does not have a corresponding country in H:\TOV Storage Folder then create one and perform the paste and move onto the next country sheet in the split workbook and repeat process.

In a very simple way I need the macro to search through the split sheets and go "Ah I have found France FR_ITOV_MTNG_ATNDEE.xlsx and you have a workbook in H:\TOV Storage Folder copy, paste, next sheet, ah I found Latvia LV_ITOV_MTNG_ATNDEE.xlsx you do not have a workbook in H:\TOV Storage Folder create workbook for Latvia, copy ,paste! and so on.

I apologies if my question is lengthy I just want to make my issue transparent.

Can my code be amended to solve my issue?

As always any and all help is greatly appreciate.

CODE 1

    Sub Make_Macro_Go_now()

Dim my_FileName As Variant

    MsgBox "Pick your TOV file" '<--| txt box for prompt to pick a file

        my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection

    If my_FileName <> False Then
    Workbooks.Open FileName:=my_FileName


Call Filter_2 '<--|Calls the Filter Code and executes

End If


End Sub

Public Sub Filter_2()


    'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

    Dim rCountry As Range, helpCol As Range

    Dim FileName As String
    Dim s As Worksheet

Dim y As Workbook ''AT
Dim y_1 As Workbook ''BE


    FileName = Right(ActiveWorkbook.Name, 22)

    With ActiveWorkbook.Sheets(1) '<--| refer to data worksheet
        With .UsedRange
            Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '<--| get a "helper" column just at the right of used range, it'll be used to store unique country names in
        End With

        With .Range("A1:Q" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| refer to its columns "A:Q" from row 1 to last non empty row of column "A"
            .Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '<-- call AdvancedFilter on 6th column of the referenced range and store its unique values in "helper" column
            Set helpCol = Range(helpCol.Offset(1), helpCol.End(xlDown)) '<--| set range with unique names in (skip header row)
            For Each rCountry In helpCol '<--| iterate over unique country names range (skip header row)
                .AutoFilter 1, rCountry.Value2 '<--| filter data on country field (6th column) with current unique country name
                If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered...
                    Worksheets.Add Worksheets(Worksheets.Count) '<--... add new sheet
                    ActiveSheet.Name = rCountry.Value2 & FileName  '<--... rename it

                    .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header



                End If
            Next
        End With
        .AutoFilterMode = False '<--| remove autofilter and show all rows back




    End With
    helpCol.Offset(-1).End(xlDown).Clear '<--| clear helper column (header included)

   ''Copy and Paste Data
   For Each s In Sheets
        If s.Name = "DE_ITOV_MTNG_ATNDEE.xlsx" Then

            s.Activate
            ActiveSheet.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy
            Set y = Workbooks.Open("H:\TOV Storage Folder\Germany.xlsx")
            y.Sheets(2).Name = "DE_ITOV_MTNG_ATNDEE"
            y.Sheets("DE_ITOV_MTNG_ATNDEE").Range("A1").PasteSpecial Paste:=xlPasteFormulas
            y.SaveAs "H:\TOV Storage Folder\Germany.xlsx"
            y.Close

            ElseIf s.Name = "BE_ITOV_MTNG_ATNDEE.xlsx" Then
            s.Activate
            ActiveSheet.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy
            Set y_1 = Workbooks.Open("H:\TOV Storage Folder\Belgium.xlsx")
            y_1.Sheets(2).Name = "BE_ITOV_MTNG_ATNDEE"
            y_1.Sheets("BE_ITOV_MTNG_ATNDEE").Range("A1").PasteSpecial Paste:=xlPasteFormulas
            y_1.SaveAs "H:\TOV Storage Folder\Belgium.xlsx"
            y_1.Close



            ''Exit Sub
        End If

    Next s
    ''MsgBox "Sheet a does not exist"

    ''End If
    'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Public Function DoesFileExist(ByVal sFile)
    Dim oFSO As New FileSystemObject
    If oFSO.FileExists(sFile) Then
        DoesFileExist = True
    Else
        DoesFileExist = False
    End If
End Function

Pic 1

Pic 2

Answer 1

You can use the function below to check if the file exists before attempting to open the workbook. If it doesn't then create a workbook, otherwise open the existing workbook

Public Function DoesFileExist(ByVal sFile)
    Dim oFSO As New FileSystemObject
    If oFSO.FileExists(sFile) Then
        DoesFileExist = True
    Else
        DoesFileExist = False
    End If
End Function

You will need to add `Microsoft Scription Runtime' reference for the above function to work