Question

我有2个文件：a和b。两者都有多个具有相同工作表名称的工作表。我想将数据从b复制到a到匹配的工作表。我的问题是如何激活与a中的活动工作表名称匹配的b文件工作表，因此我不必每次都写工作表的名称

Answer 1

定义源和目标工作簿
浏览源工作表并复制

类似的事情应该起作用

Public Sub CopyBtoA()
    Dim wbSource As Workbook
    Set wbSource = Workbooks("fileB.xlsx")

    Dim wbDestination As Workbook
    Set wbDestination = Workbooks("fileA.xlsx")

    Dim ws As Worksheet
    For Each ws In wbSource.Worksheets
        ws.Range("A1").Copy Destination:=wbDestination.Worksheets(ws.Name).Range("A1")
    Next ws
End Sub

请注意，这假定两个文件都已在Excel中打开。否则，您需要使用Workbooks.Open()打开它们，例如：

Set wbSource = Workbooks.Open Filename:="C:\your path\fileB.xlsx"

不要使用.Activate或.Select，不需要它们！参见How to avoid using Select in Excel VBA。

请注意，我建议您在复制之前检查工作表是否在目标工作簿中。否则，您将遇到错误：

Public Sub CopyBtoA()
    Dim wbSource As Workbook
    Set wbSource = Workbooks("fileB.xlsx")

    Dim wbDestination As Workbook
    Set wbDestination = Workbooks("fileA.xlsx")

    Dim ws As Worksheet
    For Each ws In wbSource.Worksheets
        If WorksheetExists(ws.Name, wbDestination) Then
            ws.Range("A1").Copy Destination:=wbDestination.Worksheets(ws.Name).Range("A1")
        End If
    Next ws
End Sub

'check if a worksheet exists
Public Function WorksheetExists(ByVal WorksheetName As String, Optional ByVal wb As Workbook) As Boolean
    If wb Is Nothing Then Set wb = ThisWorkbook 'default to thisworkbook

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Worksheets(WorksheetName)
    On Error GoTo 0

    WorksheetExists = Not ws Is Nothing
End Function

Answer 2

Public Function Sheet_NameSake( _
        ByVal ws_Name As String, _
        wb_Dest As Workbook) _
        As Worksheet

    Set Sheet_NameSake = wb_Dest.Worksheets(ws_Name)

End Function

根据来自另一个文件的工作表名称激活工作表

2 个答案: