PC Review


Reply
Thread Tools Rate Thread

Append multiple files

 
 
Mark S
Guest
Posts: n/a
 
      19th Feb 2008
I have the same demographic information in separate files from 10 different
states. I need to create a super list append the file content into one file
so I can create a mail list. How do I append 10 different excel files with
demographic information into one list? I am using Office 2007.
Mark S

 
Reply With Quote
 
 
 
 
JP
Guest
Posts: n/a
 
      19th Feb 2008
If you wanted a VBA solution, this code will take all of the
workbooks in a given folder and put them together into one worksheet
in a new workbook called "merged.xls" which is placed on your desktop.
Simply create a folder on your desktop called "merged" and place all
of the workbooks there. It assumes there is only one sheet per
workbook, and your desktop folder is located at "C:\Documents and
Settings\username\Desktop".

It works in Excel 2003, let me know if it works in 2007. Paste
into a standard module (see http://www.rondebruin.nl/code.htm for
assistance).


Option Explicit
Public Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Public Function Username() As String
Dim lpBuff As String * 1024
GetUserName lpBuff, Len(lpBuff)
Username = Left$(lpBuff, (InStr(1, lpBuff, vbNullChar)) - 1)
End Function
Sub MergeWorkbooks()
'
' this routine will go to a folder called 'merged' on your desktop and
merge all the workbooks in the folder into one
' super workbook called "merged.xls" on your desktop
'
Dim NewWB As Excel.Workbook
Dim FName As String
Dim myLastCell As String, myLastRow As Long, myLastColumn As Long
Dim myRange As String
Dim directoryfiles()
Dim count As Integer
Dim FileN As String
Dim UserN As String, AddRange As Excel.Range
Dim i As Long
Dim rng As Excel.Range
Dim A As Long

UserN = Username

Application.ScreenUpdating = False

' basic error checking
If Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged.xls")
<> "" Then
MsgBox ("MERGED.XLS already exists, clear it out before running
this macro"), vbCritical
Exit Sub
End If

If Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged\*.xls")
= "" Then
MsgBox ("No XLS files are in the directory." & vbCrLf & "Put some
workbooks there first."), vbCritical
Exit Sub
End If

' build an array of filenames for later processing
FileN = Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged\")
Do
If FileN <> "" Then
ReDim Preserve directoryfiles(count)
directoryfiles(count) = FileN
count = count + 1
End If
FileN = Dir
Loop While FileN <> ""

Set NewWB = Workbooks.Add
ActiveWorkbook.SaveAs "C:\Documents And Settings\" & UserN & "\Desktop
\" & "merged.xls", FileFormat:=xlNormal

Set AddRange = Workbooks("merged.xls").Worksheets(1).Range("A65536")

For i = 0 To UBound(directoryfiles())
Workbooks.Open ("C:\Documents And Settings\" & UserN & "\Desktop
\merged\" & directoryfiles(i))

Set rng = ActiveSheet.UsedRange.Rows
With WorksheetFunction
For A = rng.Rows.count To 1 Step -1
If .CountA(rng.Rows(A).EntireRow) = 0 Then
rng.Rows(A).EntireRow.Delete
Next A
End With

myLastRow = Cells.Find("*", [A1], , , xlByRows,
xlPrevious).Row
myLastColumn = Cells.Find("*", [A1], , , xlByColumns,
xlPrevious).Column
myLastCell = Cells(myLastRow, myLastColumn).Address
myRange = "a1:" & myLastCell
Range(myRange).Copy Destination:=AddRange.End(xlUp).Offset(2,
0)
Workbooks(directoryfiles(i)).Close savechanges:=False
Next i

Workbooks("merged.xls").Close savechanges:=True

MsgBox ("Merge complete!" & vbCrLf & vbCrLf & UBound(directoryfiles())
+ 1 & " workbooks were merged."), vbInformation

If MsgBox("Would you like to delete the separate workbooks?", vbYesNo)
= vbYes Then
For i = 0 To UBound(directoryfiles())
Kill ("C:\Documents And Settings\" & UserN & "\Desktop\merged
\" & directoryfiles(i))
Next i
MsgBox ("Done!"), vbInformation
End If


Set NewWB = Nothing
Set AddRange = Nothing
Set rng = Nothing
Application.ScreenUpdating = True
End Sub


---

HTH,
JP


On Feb 19, 2:38*pm, "Mark S" <mm...@pacbell.net> wrote:
> I have the same demographic information in separate files from 10 different
> states. I need to create a super list append the file content into one file
> so I can create a mail list. How do I append 10 different excel files with
> demographic information into one list? I am using Office 2007.
> Mark S


 
Reply With Quote
 
Ron de Bruin
Guest
Posts: n/a
 
      19th Feb 2008
See also this add-in and the link to the code page on the bottom of the page
http://www.rondebruin.nl/merge.htm

Working OK in 2007


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"JP" <(E-Mail Removed)> wrote in message news:50c54391-bc2a-48bc-9746-(E-Mail Removed)...
If you wanted a VBA solution, this code will take all of the
workbooks in a given folder and put them together into one worksheet
in a new workbook called "merged.xls" which is placed on your desktop.
Simply create a folder on your desktop called "merged" and place all
of the workbooks there. It assumes there is only one sheet per
workbook, and your desktop folder is located at "C:\Documents and
Settings\username\Desktop".

It works in Excel 2003, let me know if it works in 2007. Paste
into a standard module (see http://www.rondebruin.nl/code.htm for
assistance).


Option Explicit
Public Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Public Function Username() As String
Dim lpBuff As String * 1024
GetUserName lpBuff, Len(lpBuff)
Username = Left$(lpBuff, (InStr(1, lpBuff, vbNullChar)) - 1)
End Function
Sub MergeWorkbooks()
'
' this routine will go to a folder called 'merged' on your desktop and
merge all the workbooks in the folder into one
' super workbook called "merged.xls" on your desktop
'
Dim NewWB As Excel.Workbook
Dim FName As String
Dim myLastCell As String, myLastRow As Long, myLastColumn As Long
Dim myRange As String
Dim directoryfiles()
Dim count As Integer
Dim FileN As String
Dim UserN As String, AddRange As Excel.Range
Dim i As Long
Dim rng As Excel.Range
Dim A As Long

UserN = Username

Application.ScreenUpdating = False

' basic error checking
If Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged.xls")
<> "" Then
MsgBox ("MERGED.XLS already exists, clear it out before running
this macro"), vbCritical
Exit Sub
End If

If Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged\*.xls")
= "" Then
MsgBox ("No XLS files are in the directory." & vbCrLf & "Put some
workbooks there first."), vbCritical
Exit Sub
End If

' build an array of filenames for later processing
FileN = Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged\")
Do
If FileN <> "" Then
ReDim Preserve directoryfiles(count)
directoryfiles(count) = FileN
count = count + 1
End If
FileN = Dir
Loop While FileN <> ""

Set NewWB = Workbooks.Add
ActiveWorkbook.SaveAs "C:\Documents And Settings\" & UserN & "\Desktop
\" & "merged.xls", FileFormat:=xlNormal

Set AddRange = Workbooks("merged.xls").Worksheets(1).Range("A65536")

For i = 0 To UBound(directoryfiles())
Workbooks.Open ("C:\Documents And Settings\" & UserN & "\Desktop
\merged\" & directoryfiles(i))

Set rng = ActiveSheet.UsedRange.Rows
With WorksheetFunction
For A = rng.Rows.count To 1 Step -1
If .CountA(rng.Rows(A).EntireRow) = 0 Then
rng.Rows(A).EntireRow.Delete
Next A
End With

myLastRow = Cells.Find("*", [A1], , , xlByRows,
xlPrevious).Row
myLastColumn = Cells.Find("*", [A1], , , xlByColumns,
xlPrevious).Column
myLastCell = Cells(myLastRow, myLastColumn).Address
myRange = "a1:" & myLastCell
Range(myRange).Copy Destination:=AddRange.End(xlUp).Offset(2,
0)
Workbooks(directoryfiles(i)).Close savechanges:=False
Next i

Workbooks("merged.xls").Close savechanges:=True

MsgBox ("Merge complete!" & vbCrLf & vbCrLf & UBound(directoryfiles())
+ 1 & " workbooks were merged."), vbInformation

If MsgBox("Would you like to delete the separate workbooks?", vbYesNo)
= vbYes Then
For i = 0 To UBound(directoryfiles())
Kill ("C:\Documents And Settings\" & UserN & "\Desktop\merged
\" & directoryfiles(i))
Next i
MsgBox ("Done!"), vbInformation
End If


Set NewWB = Nothing
Set AddRange = Nothing
Set rng = Nothing
Application.ScreenUpdating = True
End Sub


---

HTH,
JP


On Feb 19, 2:38 pm, "Mark S" <mm...@pacbell.net> wrote:
> I have the same demographic information in separate files from 10 different
> states. I need to create a super list append the file content into one file
> so I can create a mail list. How do I append 10 different excel files with
> demographic information into one list? I am using Office 2007.
> Mark S


 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
How can I append multiple sheets from mulitple xls. files. into 1 salem_gladiator Microsoft Excel Misc 1 16th Jan 2009 11:02 PM
Best freeware to append multiple mpg files? vanrinsg Freeware 7 11th Jan 2009 05:39 PM
Read multiple CSV files and append into one sheet =?Utf-8?B?QWNjZXNzSGFy?= Microsoft Access External Data 3 8th Aug 2007 11:22 AM
Multiple Input files to an Append Query Andreww Microsoft Access 4 23rd Jun 2006 05:12 PM
Import & append multiple text files =?Utf-8?B?Q29tbUd1eQ==?= Microsoft Access External Data 1 12th Apr 2006 06:17 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 12:54 PM.