How to merge two excel sheets using VBA? - excel

Question

I have an Excel workbook with two sheets.
The range for the first sheet is: A1:AU
And the range for the second sheet is: B1:I
I don't want to keep A1 from the second sheet because they share the same ID column. I am using VBA in MS Access. And what I am trying to do is create a temp file from an original file, then edit it. I've been able to do this with the following code:
public function copyFile(newFilePath As String)
objFile.SaveCopyAs newFilePath
' Open the copied file
Dim copiedFile As Object
Set copiedFile = objExcel.Workbooks.Open(newFilePath)
End Function
But when I try to merge sheet2 and sheet3 together like so:
public function copyFile(newFilePath As String)
objFile.SaveCopyAs newFilePath
' Open the copied file
Dim copiedFile As Object
Set copiedFile = objExcel.Workbooks.Open(newFilePath)
Dim sheet2 As Object
Set sheet2 = copiedFile.Worksheets("sheet2")
Dim sheet3 As Object
Set sheet3 = copiedFile.Worksheets("sheet3")
' Determine last used column in sheet 2
Dim lastCol As Long
lastCol = sheet2.Cells(1, Columns.Count).End(xlToLeft).Column
Dim lastRow2 As Long
lastRow2 = sheet2.Cells(Rows.Count, "A").End(xlUp).Row
sheet3.Range("B1:I" & sheet3.Cells(Rows.Count, "B").End(xlUp).Row).Copy _
sheet2.Cells(1, lastCol + 1).Offset(lastRow2, 0)
copiedFile.Save
copiedFile.Close False
End Function
I run into this issue where all is does it create a wide cell in sheet 2 at the start of the first empty row of the excel file.
Essentially, what I'd like to do is if this is sheet 2:
col1 | col2 | col3 ...
abc | $45 | ghi
and this is sheet 3:
colx | coly | colz ...
ytr | tre | $300
Then after processing sheet 2 should look like:
col1 | col2 | col3 | colx | coly | colz
abc | $45 | ghi | ytr | tre | $300
But so far my attempts at getting this to work have failed.
Any ideas are greatly appreciated!

Answer 1

Looks like you're just getting mixed up where to start and stop the copy at
This should work according to your problem description
It assumes the number of rows and ID values in both sheets are the same.
No sorting or checking required?
With sheet2
.Activate
.Range("A1").Select
.Range(Selection, Selection.End(xlToRight)).Select
End With
lastCol = Selection.Columns.Count + 1
With sheet3
.Activate
.Range("B1").Select
.Range(Selection, Selection.End(xlToRight)).Select
.Range(Selection, Selection.End(xlDown)).Select
End With
Selection.Copy
sheet2.Cells(1, lastCol).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Answer 2

If these worksheets are really a simple structure with row 1 containing column headers and common identifier column (I call it ID), consider:
Sub getExcelData2()
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
'set connection to workbook and open recordset
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=path to folder\name.xlsx" _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
rs.Open "Select [Sheet2$].*, [Sheet3$].* FROM [Sheet2$] " & _
"INNER JOIN [Sheet3$] ON [Sheet2$].ID=[Sheet3$].ID", cn, adOpenStatic, adLockOptimistic, adCmdText
'open Excel application, add new workbook, write recordset to sheet
Dim xlApp As Object
Dim xlWbk As Object
Dim x As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Add
For x = 1 To rs.Fields.Count
xlWbk.worksheets(1).Cells(1, x) = rs(x - 1).Name
Next
xlWbk.worksheets(1).Range("A2").CopyFromRecordset rs
xlApp.Visible = True
xlApp.UserControl = True
End Sub
This uses INNER JOIN which assumes same ID values in both sheets. If that is not the case, perhaps LEFT or RIGHT JOIN will produce correct dataset. If not, the SQL statement will be more complicated.
SELECT Q1.ID, [Sheet2$].*, [Sheet3$].*
FROM [Sheet3$] RIGHT JOIN ([Sheet2$] RIGHT JOIN (SELECT ID FROM [Sheet2$]
UNION SELECT ID FROM [Sheet3$]) AS Q1 ON [Sheet2$].ID = Q1.ID) ON [Sheet3$].ID = Q1.ID;
In both examples, wildcards are used to retrieve fields because there are so many columns. This means ID data will be in multiple columns but user can ignore or delete the duplicates. Or you can expand code to find the duplicate columns and delete, like:
For x = 2 To 3
xlWbk.worksheets(1).Columns(xlWbk.worksheets(1).Cells.find(x & "$").Column).Delete
Next
Also assumes all fields in sheets are required and total fields will not exceed 255.
Should be able to replace sheet references with Named Range references - I did not test.