Merge 2 workbooks into 1

K

khawers

Hello,

I am currently working on this project where I have to take 2 workbooks
and merge 2 sheets together( Sheet1 on both workbooks are populated
only). I have figured out a way to open both the workbook sheets and
put info on one master excel sheet (This is a separate workbook that
stores the info along with the vba code). What I'm running into is
that it populates the info from workbook1 on the top then populates
info from workbook2 underneath it. I have attached the way the sheets
are populated below along with the code that I have so far. If anyone
can let me know exactly what I should be doing that be grate help. I
have windows2003 and the client might have win2002, I'm thinking it
should be ok.

Workbook1.sheet1 (nameage.xls)
EE ID Name Age Reason Amt
2 B 12 123
1 A 23 54
3 C 55 785
5 E 56 45
4 D 29 477
6 F 45 456
7 G 44 2323

Workbook2.sheet2 (namejob.xls)
EE ID Name Job Reason
1 A Marketing 10
2 B Sales 20
3 C Data Entry 30
4 D Timer 50
5 E Banker 80


Expected Output in Master.xls after macro runs
EE ID Name Age Reason Amt Job
2 B 12 20 123 Sales
1 A 23 10 54 Marketing
3 C 55 30 785 Data Entry
5 E 56 80 45 Banker
4 D 29 50 477 Timer
6 F 45 456
7 G 44 2323



Sub merge()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim SourceRcount As Long
Dim N As Long
Dim rnum As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant

SaveDriveDir = CurDir
MyPath = "C:\excel\"
ChDrive MyPath
ChDir MyPath


FName = Application.GetOpenFilename(filefilter:="Excel Files
(*.xls), *.xls", _
MultiSelect:=True)
If IsArray(FName) Then
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
rnum = 1
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet

For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))
Set sourceRange = mybook.Worksheets(1).Range("A1:D10")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")


With sourceRange
Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
Resize(.Rows.Count,
..Columns.Count)
End With
destrange.Value = sourceRange.Value

mybook.Close False
rnum = rnum + SourceRcount
Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top