Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Need to know how to make this script merge multiple excel files BUT insert them by ROW and not by COLUMN

Posted on 2008-10-15
2
251 Views
Last Modified: 2013-11-10
Thanks to Dave for helping me with this code.

I need to know how to make this code merge all excel files by row, currently it merges them by column going right to left, I just need it to merge each file one below the other.

Thanks!

strFolder = "c:\files"
strNewFile = "c:\newfile.xls"
 
    Set objexcel = CreateObject("Excel.Application")
    objexcel.Visible = False
    objexcel.DisplayAlerts = False
 
 
    Set objNewFile = objexcel.Workbooks.Add
    intLastSheet = objNewFile.Worksheets.Count
    If intLastSheet > 1 Then
        For i = 2 To intLastSheet
            objNewFile.Worksheets(2).Delete
        Next
    End If
 
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
    Set colFileList = objWMIService.ExecQuery _
                      ("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} Where " _
                     & "ResultClass = CIM_DataFile")
 
    For Each objFile In colFileList
        If LCase(objFile.Extension) = "xls" Then
            v = v + 1
 
            Set objWorkbook = objexcel.Workbooks.Open(objFile.Name)
            Set objWorkSheet = objWorkbook.Worksheets(1)
            cCount = objWorkSheet.UsedRange.Columns.Count + objWorkSheet.UsedRange.Cells(1).Column - 1
            For c = cCount To 1 Step -1
                If objexcel.CountA(objWorkSheet.Columns(c)) = 0 Then objWorkSheet.Columns(c).EntireColumn.Delete
            Next
 
            If v = 1 Then
                objWorkSheet.Copy , objNewFile.Worksheets(1)
                objNewFile.Worksheets(1).Delete
            Else
                Set objNewSheet = objNewFile.Worksheets(1)
                lastcol = objNewsheet.UsedRange.Columns.Count + objNewsheet.UsedRange.Cells(1).Column - 1
                objWorkSheet.UsedRange.EntireColumn.Copy objNewSheet.Cells(1, lastcol + 1)
            End If
            objWorkbook.Close
 
        End If
    Next
 
    objNewFile.SaveAs (strNewFile)
    objexcel.Quit

Open in new window

0
Comment
Question by:smyers051972
2 Comments
 
LVL 17

Accepted Solution

by:
ExcelGuide earned 500 total points
ID: 22728906
try this:
strFolder = "c:\files"
strNewFile = "c:\newfile.xls"
 
    Set objexcel = CreateObject("Excel.Application")
    objexcel.Visible = False
    objexcel.DisplayAlerts = False
 
 
    Set objNewFile = objexcel.Workbooks.Add
    intLastSheet = objNewFile.Worksheets.Count
    If intLastSheet > 1 Then
        For i = 2 To intLastSheet
            objNewFile.Worksheets(2).Delete
        Next
    End If
 
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
    Set colFileList = objWMIService.ExecQuery _
                      ("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} Where " _
                     & "ResultClass = CIM_DataFile")
 
    For Each objFile In colFileList
        If LCase(objFile.Extension) = "xls" Then
            v = v + 1
 
            Set objWorkbook = objexcel.Workbooks.Open(objFile.Name)
            Set objWorkSheet = objWorkbook.Worksheets(1)
            cCount = objWorkSheet.UsedRange.Columns.Count + objWorkSheet.UsedRange.Cells(1).Column - 1
            For c = cCount To 1 Step -1
                If objexcel.CountA(objWorkSheet.Columns(c)) = 0 Then objWorkSheet.Columns(c).EntireColumn.Delete
            Next
 
            If v = 1 Then
                objWorkSheet.Copy , objNewFile.Worksheets(1)
                objNewFile.Worksheets(1).Delete
            Else
                Set objNewSheet = objNewFile.Worksheets(1)
                lastcol = objNewsheet.UsedRange.Columns.Count + objNewsheet.UsedRange.Cells(1).Column - 1
                objWorkSheet.UsedRange.EntireColumn.Copy objNewSheet.Cells(Rows.Count , "A").End(xlUp).Row)
            End If
            objWorkbook.Close
 
        End If
    Next
 
    objNewFile.SaveAs (strNewFile)
    objexcel.Quit

Open in new window

0
 
LVL 1

Author Closing Comment

by:smyers051972
ID: 31506474
Thank you worked perfectly!
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question