加入兩個宏

Question

我希望你很好，可以提供幫助。我有兩段代碼，我試圖加入一個宏。

我有第一塊代碼允許用戶點擊一個命令按鈕，打開一個txt框並允許用戶選擇一個文件。 一旦選擇了這個文件，我就想讓第二段代碼去做它的事情，那就是通過F列並找到一個國家，然後創建一個新的工作表副本並將該國家的數據粘貼到新工作表中並命名爲然後返回到F列並重復其他國家。

我添加了一張照片，因爲我認爲這可能會使它更容易。看到結尾

這兩段代碼獨立工作很好，我只需要加入他們。

1ST一段代碼**選擇文件和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 

Answer 1

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