Hi,
I am trying to append multiple excel workbooks into. Basically to
merge daily reports into a weekly one.
I found the code below somewhere on internet but it is not working for
me.
Can someone please look and let me know how I need to change this in
order to make it work ?
Sub AppendData()
Dim fso As Scripting.FileSystemObject
Dim folder As Scripting.folder
Dim file As Scripting.file
Dim rngEntry As Range
Set rngEntry = Range("a1")
Set fso = New FileSystemObject
Set folder = fso.GetFolder("C:\test\")
Dim wbkMaster As Workbook
Dim shtMaster As Worksheet
Dim rngMaster As Range
Dim wbkData As Workbook
Dim shtData As Worksheet
Dim rngData As Range
' change path and file name to suit
Set wbkData = Workbooks.Open(path)
Set shtMaster = wbkMaster.Worksheets(1)
For Each file In folder.Files
If LCase(Right(file.Name, 4)) = ".xls" Then
Dim path As String
path = file.path
MsgBox path
Set wbkData = Workbooks.Open(path)
Set shtData = wbkData.Worksheets(1)
' get end of master
Set rngMaster = shtMaster.Range("A65536").End(xlUp).Offset
(1)
'MsgBox "Address = " & rngMaster.Address
' get all data cells
Set rngData = shtData.Range("B28:F28")
' copy data across
rngData.Copy rngMaster
MsgBox "Appended " & rngData.Rows.Count & " rows of data
to Master data", vbInformation
' simply close data
wbkData.Close False
' save and close master
wbkMaster.Close True
End If
Next file
' release objects
Set rngData = Nothing
Set shtData = Nothing
Set wbkData = Nothing
Set rngMaster = Nothing
Set shtMaster = Nothing
Set wbkMaster = Nothing
End Sub
--~--~---------~--~----~------------~-------~--~----~
----------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to [email protected]
If you find any spam message in the group, please send an email to:
Ayush Jain @ [email protected] or
Ashish Jain @ [email protected]
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,500 subscribers worldwide and receive many nice notes about the
learning and support from the group. Our goal is to have 10,000 subscribers by
the end of 2009. Let friends and co-workers know they can subscribe to group at
http://groups.google.com/group/excel-macros/subscribe
-~----------~----~----~----~------~----~------~--~---
