VBA，供用户选择文件并复制选定的工作表，以将用户表单中的选择复制到活动工作簿

Question

我需要将支持选项卡/工作表复制到我正在使用的活动工作簿中。我希望用户能够使用 VBA 文件对话框，能够选择文件，使该文件中的选项卡显示在用户窗体中，并让用户选择要复制/移动到活动工作簿的选项卡。我拥有的最接近的代码如下，但此代码仅列出活动工作簿中所选工作表的工作表名称。你能帮我吗？

    Dim FilePicker As FileDialog
    Dim mypath As String
    Dim sheet_name As String
    Dim sheet_count As Integer
    Dim i As Integer
    Dim ws As Worksheet
    Dim i As Integer, sht As String, arr() As String, n As Long

    Application.ScreenUpdating = False

    Set ws = ThisWorkbook.Sheets(1)
    Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker
    .Title = "Please Select a File"
    .ButtonName = "Confirm"
    .AllowMultiSelect = False
    If .Show = -1 Then
    mypath = .SelectedItems(1)
    Else
    End
    End If
    End With

    End Sub


Private Sub CommandButton1_Click()
    Dim i As Integer, sht As String, arr() As String, n As Long
   
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ReDim Preserve arr(n)
            arr(n) = ListBox1.List(i)
            n = n + 1
        End If
    Next i
    Sheets(arr).Copy
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        For sh = 1 To Sheets.Count
            .AddItem ActiveWorkbook.Sheets(sh).Name
        Next sh
        .MultiSelect = 1
    End With
End Sub

我尝试在用户表单中使用此代码，但它不会将所选工作簿中的选项卡拉入用户表单。我只是得到一个空白的用户表单，没有显示任何选项卡。

Answer 1

这样的东西应该有效：

Option Explicit

Dim wb As Workbook

Private Sub CommandButton1_Click()
    Dim i As Integer, sht As String, arr() As String, n As Long
   
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ReDim Preserve arr(n)
            arr(n) = ListBox1.List(i)
            n = n + 1
        End If
    Next i
    wb.Sheets(arr).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    wb.Close   '?
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Set wb = GetSelectedWorkbook() 'ask user to pick a file
    
    If wb Is Nothing Then 'no file selected
        MsgBox "No file selected!"
        Exit Sub
        Unload Me
    End If
    
    For Each ws In wb.Worksheets
        ListBox1.AddItem ws.Name
    Next ws
    ListBox1.MultiSelect = 1
    
End Sub

Function GetSelectedWorkbook() As Workbook
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Please Select an Excel File"
        .ButtonName = "Confirm"
        .AllowMultiSelect = False
        If .Show = -1 Then Set GetSelectedWorkbook = _
                        Workbooks.Open(.SelectedItems(1))
    End With
End Function