title: VBA to copy into a new workbook and save
body: <p>I hope you can help. I have code below. Essentially what it does is, it opens a dialog box that allows a user to select an excel sheet, then it goes out to the country column (11) filters it, then copies and paste that country into a new worksheet names the new worksheet after that country then repeats the action for the next country. </p>
  
  <p>What I want it to do now is instead of creating a new sheet and naming it. I want it to create a new workbook for each country, copying and pasting the information, and then saving and naming the new workbook to a folder. </p>
  
  <p>My Code is below. </p>
  
  <p>Any help is as always greatly appreciated. </p>
  
  <pre><code>Sub Open_Workbook_Dialog()
  
  Dim my_FileName As Variant
  
      MsgBox "Pick your TOV file" '&lt;--| txt box for prompt to pick a file
  
          my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '&lt;--| Opens the file window to allow selection
  
      If my_FileName &lt;&gt; False Then
      Workbooks.Open Filename:=my_FileName
  
  
  Call Filter '&lt;--|Calls the Filter Code and executes
  
  End If
  
  
  End Sub
  
  Public Sub Filter()
      Dim rCountry As Range, helpCol As Range
  
      With Worksheets("CountryList") '&lt;--| refer to data worksheet
          With .UsedRange
              Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '&lt;--| 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:Y" &amp; .Cells(.Rows.Count, 1).End(xlUp).Row) '&lt;--| refer to its columns "A:Q" from row 1 to last non empty row of column "A"
              .Columns(11).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '&lt;-- 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)) '&lt;--| set range with unique names in (skip header row)
              For Each rCountry In helpCol '&lt;--| iterate over unique country names range (skip header row)
                  .AutoFilter 11, rCountry.Value2 '&lt;--| filter data on country field (6th column) with current unique country name
                  If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) &gt; 1 Then '&lt;--| if any cell other than header ones has been filtered...
                      Worksheets.Add Worksheets(Worksheets.Count) '&lt;--... add new sheet
                      ActiveSheet.Name = rCountry.Value2  '&lt;--... rename it
                      .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header
                  End If
              Next
          End With
          .AutoFilterMode = False '&lt;--| remove autofilter and show all rows back
      End With
      helpCol.Offset(-1).End(xlDown).Clear '&lt;--| clear helper column (header included)
  End Sub
  </code></pre>
  
  <p><a href="https://i.stack.imgur.com/zRDP6.png" rel="nofollow"><img src="https://i.stack.imgur.com/zRDP6.png" alt="enter image description here"></a></p>