Wednesday, 15 February 2017

How to consolidate excel workbooks with multiple excel sheets using vba code

The below vba code is to consolidate for excel sheets and excel files. This code meets your consolidation requirement and no need to worry about whether you have sheets or workbooks, however it will understand your requirement and perform accordingly.

  1.  Copy the below code and paste it in vba editor and save, otherwise it will get an error.
  2.  And the Consolidated file will gonna save in the location where your macro file saved.

Sub ConsolidateBooksandSheets()

Dim selectedpath As String
Dim strpath As Object
Dim fso As Object
Dim SheetsCount As Integer
Dim LastColumn, LastRow As Integer

Application.DisplayAlerts = False

Set fso = CreateObject("scripting.filesystemobject")
selectedpath = "C:\Users\KorampT\Desktop\Miscellaneous" & "\" 'Give your files location path
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Consolidated File.xlsx" ' The consolidated file will save where thisworkbook saved

    For Each strpath In fso.getfolder(selectedpath).Files
       
        If Right(strpath, 5) = ".xlsx" Or Right(strpath, 4) = ".xlsx" Or Right(strpath, 5) = ".xlsb" Then

            Workbooks.Open strpath
           
            If ActiveWorkbook.Sheets.Count > Workbooks("Consolidated File.xlsx").Sheets.Count Then
                a = ActiveWorkbook.Sheets.Count
                b = Workbooks("Consolidated File.xlsx").Sheets.Count
                For c = b + 1 To a
                    Workbooks("Consolidated File.xlsx").Sheets.Add after:=Sheets(c - 1)
                Next c
            End If
            For SheetsCount = 1 To ActiveWorkbook.Sheets.Count
                ActiveWorkbook.Sheets(SheetsCount).Activate
                LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
                LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
                If ActiveSheet.Range("a1").Value <> "" Then
                    If Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a1").Value = "" Then
                        ActiveSheet.Range(Cells(1, 1), Cells(LastRow, LastColumn)).Copy
                        Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a" & Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial
                        Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Name = ActiveSheet.Name
                    Else
                        ActiveSheet.Range(Cells(2, 1), Cells(LastRow, LastColumn)).Copy
                        Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a" & Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
                    End If
                End If
           
            Next SheetsCount
            ActiveWorkbook.Close
           
        End If
    Next strpath
    Workbooks("Consolidated File.xlsx").Save
End Sub

How to read pdf file using vba code


Sub Readpdffile()

Dim selectedpath as string
Dim app as Acrobat.AcroApp
Dim avdoc as Acrobat.AcroAVDoc
Dim pddoc as Acrobat.AcroPDDoc
Dim JSO as object

selectedpath = "C:\Users\Test\Desktop\Walden Design.pdf"

Set app = CreateObject("acroexch.app")
Set avdoc = CreateObject("acroexch.avdoc")


        If avdoc.Open(selectedpath, "") = True Then
                    avdoc.BringToFront
                    Set pddoc = avdoc.GetPDDoc
                    Set JSO = pddoc.GetJSObject

                     For y = 0 to pddoc.GetNumPages - 1
                              For x = 0 To JSO.getpagenumwords - 1
                                      Debug.print  JSO.getpagenthword(y,x)
                                       call JSO.selectpagenthword(y,x)
                              next x
                     next y
        end if
        avdoc.close 1
        app.exit

End sub