join两个macros

我希望你很好,可以帮忙。 我有两块代码,我试图join一个macros。

我有的第一块代码允许用户点击一个命令button打开一个txt框,并允许用户select一个文件。 一旦select了这个文件,然后我想要第二块代码做它的事情,这是通过F列,并find一个国家,然后创build一个新的工作表复制,并粘贴到该国家的数据到新的工作表,并命名该工作表国家然后回到F列,并重复其他国家。

我添加了一张照片,因为我认为这可能会使它更容易。 看到最后

这两个代码独立工作,我只是需要join他们。

第一块代码**select文件和MSB框**

Sub Click_Me() Application.ScreenUpdating = False 'Turns off switching to exported excel file once it gets opened Application.DisplayAlerts = False 'Turns off automatic alert messages Application.EnableEvents = False ' Application.AskToUpdateLinks = False 'Turns off the "update links" prompt 'User prompt, choose HCP file MsgBox "Choose TOV file missing consent information" 'Alternative way to open the file Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) fd.AllowMultiSelect = False 'Assign a number for the selected file Dim FileChosen As Integer FileChosen = fd.Show If FileChosen <> -1 Then 'Didn't choose anything (clicked on CANCEL) MsgBox "No file selected - aborted" End 'Ends file fetch and whole sub End If End Sub 

2ND一段代码**将F栏分隔成其他页面复制粘贴并命名**

 Option Explicit Sub Filter() Dim rCountry As Range, helpCol As Range With Worksheets("CountryList") '<--| 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).Row) '<--| refer to its columns "A:Q" from row 1 to last non empty row of column "A" .Columns(6).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 6, 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 '<--... 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) End Sub 

在这里输入图像说明

 If FileChosen <> -1 Then MsgBox "No file selected - aborted" Else Call Filter End If