0
votes

I have two workbooks. The first workbook(69 worksheets)has old data and the second workbook has new data for some of the worksheets(42 worksheets) of Workbook1. Only the first three columns needs updation in the first workbook. SO I want to create a macro running a loop though Workbook1 from sheet 1 to all the worksheets, finding the same worksheet name in Workbook 2 and copying first three columns and updating them in Workbook1. Can somebody please help me with it.I have created the following code , obviously not working!!

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
1
Glad to hear it shook out! Please mark the answer as accepted when you have a moment -- here is an example: i.stack.imgur.com/uqJeW.png - Dan Wagner

1 Answers

0
votes

This ought to do the trick:

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