当工作表名称相同时，从工作表复制到工作表

Question

我有两个带有工作表的工作簿（具有相同的名称）。如果工作表的名称相同，我想将特定单元格从一个工作表复制并粘贴到另一个工作表。

我试图根据另一个工作簿中的名称将工作表的名称与数组进行比较，但在比较时会堆栈

Sub check()
    Dim xArray, i
    Dim x As Workbook
    Dim ws As Worksheet

    Set x = Workbooks.Open("C:\Users\user\Desktop\xxx.xlsx", False)


    With x
    ReDim xArray(1 To Sheets.Count)
    For i = 1 To Sheets.Count
        xArray(i) = x.Sheets(i).Name
Debug.Print xArray(i)
    Next
    End With
x.Close (False)

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = xArray Then
    ' copy for each worksheet define in xArray xxx.xlsx file, range A1,B4,D5:G5
    ' and paste to worksheet with the same name in this open workbook

End Sub

感谢您的帮助！

Answer 1

对于此功能，您无需创建数组，只需使用下面提到的简单逻辑即可轻松完成。您还可以在下面的代码中自定义或替换您的工作簿和工作表名称以及复制粘贴范围。

Sub so()
Dim wb As Workbook
Dim wb1 As Workbook
Set wb = Workbooks("Book1.xlsx")
Set wb1 = Workbooks("Book2.xlsx")
Dim wk As Worksheet
Set wk = wb.Worksheets("Sheet1")
Dim wm As Worksheet
Set wm = wb1.Worksheets("Sheet1")

If (wk.Name = wm.Name) Then
        Dim TR As Integer
        TR = wk.Range("A" & Rows.Count).End(xlUp).Row
        wk.Range("A1:A" & TR).Copy wm.Range("A1")
        Application.CutCopyMode = False

       End If

End Sub

Answer 2

使用错误处理程序来测试工作表是否存在。

Sub check()
    Dim wb As Workbook, SouceWorksheet As Worksheet, TargetWorksheet As Worksheet
    Set wb = Workbooks.Open("C:\Users\user\Desktop\xxx.xlsx", False)

    For Each SouceWorksheet In wb.Worksheets
        On Error Resume Next
        Set TargetWorksheet = ThisWorkbook.Worksheets(SouceWorksheet.Name)
        On Error GoTo 0

        If Not TargetWorksheet Is Nothing Then
            SouceWorksheet.Range("A1").Copy TargetWorksheet.Range("A1")
            SouceWorksheet.Range("B4").Copy TargetWorksheet.Range("B4")
            SouceWorksheet.Range("D5:G5").Copy TargetWorksheet.Range("D5:G5")
        End If
    Next
    wb.Close False
End Sub