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
246 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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

My experience with Windows 10 over a one year period and suggestions for smooth operation
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

757 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now