VBA：如果工作簿中的工作表名称等于从用户窗体中选择的组合框值，则复制该工作表并将其粘贴到另一个工作簿中

Question

I am working on a Userform that will copy a specific sheet from Workbook A and paste it into Workbook B (essentially archiving that data). The Userform presents the user with a combo-box dropdown to select the sheet name to be copied. I receive a subscript out of range error however when using the sheets.copy command. Here is my code with names modified for ease of reading:

    Dim ws as Worksheet
    Dim WorkbookA as Workbook
    Dim WorkbookB as Workbook
    Dim ComboBoxValue as String


    Set WorkbookA as ActiveWorkbook
    Set WorkbookB as Workbook.Open("C:File Path Here")

    With ThisWorkbook
        For Each ws In Application.ActiveWorkbook.Worksheets
            If ws.Name = UserForm1.ComboBox1.Text Then
                ComboBoxValue = ws.Name
                Worksheets(ComboBoxValue).Copy _ 
                After:=Workbooks("Workbook B.xlsm").Sheets(Sheets.Count) 
                ' Run-Time 9 Subscript Out of Range Error occurs on line above ^
                ActiveSheet.Name = UserForm1.ComboBoxSelection.Text
                WorkbookB.Save
                WorkbookB.Close
                WorkbookA.Activate
                Application.CutCopyMode = False
            End If
        Next ws
    End With

Answer 1

The root of your error is improper refenceing of the workbook. There are a lot of other issues, too.

• Unnecassary reference to ThisWorkbook
• Unnecassary loop through all worksheets
• Unnecassary renaming of copied sheet
• Unnecassry / incorrect references to the ActiveWorkbook and ActiveSheet
• No Error Handling
• Improper indenting

Your code, refactored. This is written as a button click event in the UserForm. Update to suit your needs.

Option Explicit

Const ArchiveFilePath As String = "C:\Path\To\ArchiveBook.xlsx"

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim WorkbookA As Workbook
    Dim WorkbookB As Workbook
    Dim wsName As String

    Application.ScreenUpdating = False

    Set WorkbookA = ActiveWorkbook

    wsName = UserForm1.ComboBox1.Text
    If wsName = vbNullString Then Exit Sub

    On Error Resume Next 'Handle possibility that Open fails
    Set WorkbookB = Workbooks.Open(ArchiveFilePath)
    On Error GoTo 0
    If WorkbookB Is Nothing Then
        MsgBox "Failed to open " & ArchiveFilePath, vbOKOnly, "Error"
        Exit Sub
    End If

    'Check if specified ws already exists in WorkbookB
    Set ws = GetWorksheet(WorkbookB, wsName)
    If Not ws Is Nothing Then
        ' Sheet already exists.  What now?
        MsgBox "Sheet " & wsName & " already exists in " & WorkbookB.Name & ".  What now?", vbOKOnly, "Error"
        WorkbookB.Close
        Exit Sub
    End If

    Set ws = GetWorksheet(WorkbookA, wsName)
    If ws Is Nothing Then
        MsgBox "Sheet " & wsName & " does not exist in " & WorkbookA.Name, vbOKOnly, "Error"
        WorkbookB.Close
        Exit Sub
    End If

    ws.Copy After:=WorkbookB.Sheets(WorkbookB.Sheets.Count)

    WorkbookB.Save
    WorkbookB.Close

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Private Function GetWorksheet(wb As Workbook, wsName As String) As Worksheet
    On Error GoTo EH
    Set GetWorksheet = wb.Worksheets(wsName)
EH:
End Function

Answer 2

Change Sheets(Sheets.Count) to Sheets(Workbooks("Workbook B.xlsm").Sheets.Count)

In this context, Sheets(Sheets.Count) is referring to your source workbook object, so you must specify to count the sheets in the other book.