Thread: Merge Unshared Workbook
05-31-13, 12:44 #1Registered User
- Join Date
- May 2013
Unanswered: Merge Unshared Workbook
I'm trying to merge data into one master sheet from various files. The files are all from the master sheet but have different values in some columns that are blank in the master. Ideally, i want to have excel run a macro that replaces blank values in my master file with the values from the other workbooks. I have tried writing the macro as follows but it is not adding all data values.
Option Explicit Public Sub MergeWorkbooks() Dim strWorkbook1 As String Dim wb1 As Workbook Dim ws1 As Worksheet Dim oCell1 As Range Dim strWorkbook2 As String Dim wb2 As Workbook Dim ws2 As Worksheet Dim oCell2 As Range Dim iChanged As Long Dim strMessage As String strWorkbook1 = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*") If strWorkbook1 = "False" Then Exit Sub strWorkbook2 = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*") If strWorkbook2 = "False" Then Exit Sub Application.ScreenUpdating = False Set wb1 = Workbooks.Open(strWorkbook1) Set ws1 = wb1.Sheets(1) Set wb2 = Workbooks.Open(strWorkbook2) Set ws2 = wb2.Sheets(1) iChanged = 0 For Each oCell1 In ws1.UsedRange Set oCell2 = ws2.Range(oCell1.Address) If IsEmpty(oCell2) Then If Not IsEmpty(oCell1) Then oCell1.Copy Destination:=oCell2 iChanged = iChanged + 1 End If End If Next oCell1 Application.ScreenUpdating = True strMessage = vbCrLf _ & "Values from " & wb1.Name & " have been overlaid onto " & wb2.Name & "." _ & Space(10) & vbCrLf & vbCrLf _ & "Number of cells updated: " & iChanged _ & Space(10) & vbCrLf & vbCrLf _ & "Please save " & wb2.Name & " if you want to preserve these changes." _ & Space(10) wb1.Close savechanges:=False MsgBox strMessage, vbOKOnly + vbExclamation End Sub
06-06-13, 06:35 #2Grumpy old man (training)
Provided Answers: 7
- Join Date
- Sep 2006
- Surrey, UK
The code logic looks fine. What happens when you run it?10% of magic is knowing something that no-one else does. The rest is misdirection.
Beers earned: 1