Question

我有两本工作簿。第一个工作簿（69个工作表）具有旧数据，第二个工作簿具有Workbook1的一些工作表（42个工作表）的新数据。只有前三列需要在第一个工作簿中进行更新。所以我想创建一个宏，通过Workbook1从工作表1到所有工作表运行循环，在工作簿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

Answer 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

在其他工作簿中搜索特定工作簿的工作表名称，并将字母中的前三列复制到前一个工作簿

1 个答案: