Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

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
?
263 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 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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

This is an article on how to answer questions, earn points and become an expert.
No other job is as rewarding and demanding as building an iPhone app is. It is not really in the hands of the developer for the success of an iPhone app. Many factors operate jointly for every iOS application's success in the market.
Starting up a Project
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…

572 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