vba merge excel

From: Stefan B. Rusynko - view profile
Date: Sun, Jul 2 2000 12:00 am
Email: "Stefan B. Rusynko"
Groups: microsoft.public.office.developer.vba
Not yet rated
Rating:
show options

Reply | Reply to Author | Forward | Print | Individual Message | Show original | Report Abuse | Find messages by this author

Paste this in module in a new workbook (say update.xls)

01 Sub Update() ' Macro Run from "empty" Workbook which then becomes Timesheet.xls
02 Dim iItems As Integer 'Number of Records in Time.xls
03 Windows("Employees.xls").Activate 'Data Must be Unique & Sorted
03a ' Workbooks.Open Filename:="Employees.xls" 'Or Open It with a Path
04 Range("A1").Select
05 Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
06 Selection.NumberFormat = "General" 'Get data Types Consistent
07 ActiveWorkbook.Names.Add Name:="Data", RefersToR1C1:=Selection
08 Windows("Time.xls").Activate 'Data can be Unsorted w/ Dupes
08a ' Workbooks.Open Filename:="Time.xls" 'Or Open It with a Path
09 Range("A1").Select
10 Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
11 Selection.NumberFormat = "General" 'Get data Types Consistent
12 iItems = Selection.Rows.Count 'Get # of Records
13 Selection.Copy 'Create Timesheet Core
14 ThisWorkbook.Activate
15 Range("A1").Select: ActiveSheet.Paste 'Now Get Hours
16 Range("B1").Select: Selection.EntireColumn.Insert
17 ActiveCell.Formula = "=VLOOKUP(A1,Employees.xls!Data,2,FALSE)"
18 Selection.Copy: Range(Cells(1, 2), Cells(iItems, 2)).Select
19 ActiveSheet.Paste: Application.CutCopyMode = False
20 Range("C1").Select: Selection.EntireColumn.Insert 'Get Jobs
21 ActiveCell.Formula = "=VLOOKUP(A1,Employees.xls!Data,3,FALSE)"
22 Selection.Copy: Range(Cells(1, 3), Cells(iItems, 3)).Select
23 ActiveSheet.Paste: Application.CutCopyMode = False
24 Application.CalculateFull
25 Range("A1").Select 'Break Links to Employee Data
26 Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
27 Selection.Copy: Selection.PasteSpecial Paste:=xlValues
28 Range("A1").Select: Application.CutCopyMode = False
29 ActiveWorkbook.SaveAs Filename:="Timesheet.xls" 'And Save New Book
30 End Sub

Note line numbers added only for newsreader line wraps - can be deleted
--
SBR @ ENJOY (-:

For Newsgroup Posts Always Reply to Newsgroup Only!
Direct Emails for Help are Responded to on a Pay for Service Basis.