Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
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
Medium Priority
?
258 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
[X]
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
2 Comments
 
LVL 17

Accepted Solution

by:
ExcelGuide earned 2000 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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
This article will show how Aten was able to supply easy management and control for Artear's video walls and wide range display configurations of their newsroom.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
Six Sigma Control Plans

604 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