在其他工作簿中搜索特定工作簿的工作表名称并将前三列从后者复制到前者答案

【问题标题】：Searching a sheetname of a particular workbook in other workbook and copy first three columns from the latter to former在其他工作簿中搜索特定工作簿的工作表名称并将前三列从后者复制到前者
【发布时间】：2014-05-04 11:07:10
【问题描述】：

我有两本工作簿。第一个工作簿（69 个工作表）具有旧数据，第二个工作簿具有 Workbook1 的某些工作表（42 个工作表）的新数据。第一个工作簿中只有前三列需要更新。所以我想创建一个宏，通过 Workbook1 从工作表 1 到所有工作表运行一个循环，在 Workbook 2 中找到相同的工作表名称并复制前三列并在 Workbook1 中更新它们。有人可以帮我吗。我创建了以下代码，显然不起作用！

Sub Macro1()
Dim i As Integer
Dim x As Integer
Dim wb2 As Excel.Workbook
Dim rngToCopy As Range
Dim rngToPaste As Range
Set wb2 = Workbooks.Open("D:\Sediment extraction\Analysis\updatedextractedresults_45.xls")
j = ThisWorkbook.Worksheets.Count
k = wb2.Worksheets.Count
For i = 1 To j
    For x = 1 To k
        If ThisWorkbook.Sheets(i).Name = wb2.Sheets(x).Name Then

wb2.Sheets(x).Activate
Set rngToCopy = ThisWorkbook.Sheets(x).Range("A1",ThisWorkbook.Sheets(x).Range("A65536").End(xlUp)).Resize(, 3)

'With rngToCopy
Set rngToPaste = ThisWorkbook.Sheets(i).Range("A1").Resize(.Rows.Count, .Columns.Count)
End With
'rngToPaste.Value = rngToCopy.Value
        End If
    Next x
Next i
End Sub

【问题讨论】：

很高兴听到它震动了！请在您有时间的时候将答案标记为已接受 - 这是一个示例：i.stack.imgur.com/uqJeW.png

标签： excel vba

【解决方案1】：

这应该可以解决问题：

Option Explicit
Sub UpdateOldDataWorkbook()

Dim NewWb As Workbook, OldWB As Workbook
Dim NewWs As Worksheet, OldWs As Worksheet
Dim LastRow As Long
Dim NewRange As Range, OldRange As Range

'set references up-front
Set NewWb = ThisWorkbook
Set OldWB = Workbooks.Open("D:\Sediment extraction\Analysis\updatedextractedresults_45.xls")

'loop through all the new worksheets in the new workbook
For Each NewWs In NewWb.Worksheets
    'find the matching old sheet
    If DoesSheetExist(NewWs.Name, OldWB) Then
        Set OldWs = OldWB.Worksheets(NewWs.Name)
        'collect the new data and assign it to a range for easy copy
        With NewWs
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Set NewRange = Range(.Cells(1, 1), .Cells(LastRow, 3))
        End With
        'clear the first 3 columns
        With OldWs
            .Range("A:C").ClearContents
            Set OldRange = Range(.Cells(1, 1), .Cells(LastRow, 3))
        End With
        NewRange.Copy Destination:=OldRange
    End If
Next NewWs

End Sub

'this function checks to see if a sheet exists in a target workbook
Public Function DoesSheetExist(dseWorksheetName As Variant, dseWorkbook As Variant) As Boolean
    Dim obj As Object
    On Error Resume Next
    'if there is an error, sheet doesn't exist
    Set obj = dseWorkbook.Worksheets(dseWorksheetName)
    If Err = 0 Then
        DoesSheetExist = True
    Else
        DoesSheetExist = False
    End If
    On Error GoTo 0
End Function

【讨论】：