Excel 将单元格复制到另一个工作簿，其中主工作簿的单元格A1上有命名的工作表

我有一个带有母版页的工作簿，母版页由A1中下拉框的选择填充。我需要将主工作表中的一些信息复制到另一个工作簿中，其中工作表名称与下拉框对应。我已经编写了宏，但是我很难根据主工作表A1中的内容查看工作表名称。它遇到麻烦的地方是shtName。我相信这将工作，如果我可以通过它没有看到表名

Sub Copy_With_AutoFilter()

Dim My_Range As Range
Dim wsMASTER As Worksheet
Dim shtName As Worksheet
Dim CalcMode As Long
Dim ViewMode As Long
Dim FilterCriteria As String
Dim CCount As Long
Dim rng As Range
Dim wbTarget As Workbook
Dim wbSource As Workbook

'Set filter range on ActiveSheet
Set My_Range = Range("A94:E119")

'Set the sheet
Set wbSource = ThisWorkbook
Set wsMASTER = wbSource.Worksheets("MASTER")
Set shtName = wbSource.Worksheets(wsMASTER.Range("A1").Value)

'Set the destination worksheet
Set wbTarget = Workbooks.Open("A:\Accounting\Manifest Project\Manifest\2014\Completion Bonus\Summer Bonus\" & shtName & ".xlsx")

'Unprotect Sheet
If ActiveWorkbook.ProtectStructure = True Or _
    My_Range.Parent.ProtectContents = True Then
      MsgBox "Sorry, not working when the workbook or worksheet is protected", _
            vbOKOnly, "Copy to new worksheet"
      Exit Sub
End If

'Change ScreenUpdating, Calculation, EnableEvents, .....
With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False

'Firstly, remove the AutoFilter
My_Range.Parent.AutoFilterMode = False

'Filter and set the filter field and the filter criteria
My_Range.AutoFilter Field:=1, Criteria1:=">0"

'Check if there are not more then 8192 areas
CCount = 0
On Error Resume Next
CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisisble).Areas(1).cells.Count
On Error GoTo 0
If CCount = 0 Then
    MsgBox "There are more than 8192 areas:" _
         & vbNewLine & "It is not possible to copy the visible data.", _
           vbOKOnly, "Copy to worksheet"
Else
    'Copy the visible data and use PasteSpecial to paste to the Destsh
    With My_Range.Parent.AutoFilter.Range
        On Error Resume Next
        'Set rng to the visible cells in My_Range without the header row
        Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
                  .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not rng Is Nothing Then
            'Copy and paste the cells into DestSh below the existing data
            rng.Copy
            With wbTarget.Range("A" & LastRow(wbTarget) + 1)
                .PasteSpecial Paste:=8
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
        End If
    End With
End If

'Close AutoFilter
My_Range.Parent.AutoFilterMode = False

'Restore ScreenUpdating, Calculation, EnableEvents, ....
ActiveWindow.View = ViewMode
Application.Goto wbTarget.Range("A1")
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = CalcMode
End With
End Sub

您的问题表明您想要的工作表在wbTarget中，而不是wbSource中

请尝试以下修订版本：

Dim sName as String

Set wbSource = ThisWorkbook
Set wsMASTER = wbSource.Worksheets("MASTER")

Set wbTarget = Workbooks.Open("A:\Accounting\Manifest Project\Manifest\2014\" & _
                          "Completion Bonus\Summer Bonus\Completion Bonus.xlsx")

sName = wsMASTER.Range("A1").Value

On Error Resume Next
Set shtName = wbTarget.Worksheets(sName)
On Error Goto 0

If shtName is Nothing Then
    Msgbox "Sheet '" & sName "' was not found in target workbook!"
    Exit Sub
End If

'rest of code using shtName

---

我要复制到的工作表位于wbTarget中，但工作表的名称与wbSource的A1中的名称匹配，并且在下拉框更改时会更改。这就是我在代码中遇到的问题。你是如何告诉它的，所以它最终会出现在正确的工作表上的？为了补充一点关于这个问题的信息，如果我保持原样，我会在那一行得到一个运行时错误91。如果我把它改成wbTarget，我会在那一行得到一个运行时错误9。尝试过它，现在它在Set-wbTarget上给了我一个运行时错误91。我开始觉得不可能让它在另一个基于源工作簿单元格的工作簿中找到工作表。我整天都在为这件事绞尽脑汁。我要休息一下，好好睡一觉。谢谢你给我的任何想法。再次查看你的代码，它与你描述的你正在尝试做的事情并不匹配。你从主工作表中得到了什么？是文件名还是工作表名？您似乎正在使用这两个值。。。。

Dim sName as String

Set wbSource = ThisWorkbook
Set wsMASTER = wbSource.Worksheets("MASTER")

Set wbTarget = Workbooks.Open("A:\Accounting\Manifest Project\Manifest\2014\" & _
                          "Completion Bonus\Summer Bonus\Completion Bonus.xlsx")

sName = wsMASTER.Range("A1").Value

On Error Resume Next
Set shtName = wbTarget.Worksheets(sName)
On Error Goto 0

If shtName is Nothing Then
    Msgbox "Sheet '" & sName "' was not found in target workbook!"
    Exit Sub
End If

'rest of code using shtName