• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Multi workbook data in one excel sheet

Rajendar

Member
Purchase order summary: multi workbooks data in one excel sheet

i created one folder the name is purchase order year of 2017. in that i created purchase orders on daily basis. i want all the workbook data summary in one file that called as purchase order summary year of 2017.

I tried in vba but there are some error's

Please help me on this.
 

Attachments

  • PURCHASE ORDER YEAR OF 2017.zip
    122.9 KB · Views: 3
Hi,

If I understood correctly, you want some code to aggregate all the info from the various purchase orders (stored in a specific folder) into a single sheet.

If so, please take a look at the attached file.
Don't forget to change the path (in both instances were it is used) to fit your particular case.

Hope this helps
 

Attachments

  • PURCHASE ORDER SUMMARY YEAR OF 2017.xlsm
    22.8 KB · Views: 5
Dear Sir,

Yes.

i change the file path to desktop

Wrkb = ActiveWorkbook.Name
StrFile = Dir("C:\desktop\PURCHASE ORDER YEAR OF 2017\*IPO*")

Do While Len(StrFile) > 0
Workbooks.Open "C:\desktop\PURCHASE ORDER YEAR OF 2017\" & StrFile

Then Summary file also i pasted in to the same specific folder is it right.

Then i run the macro the summary sheet is blank with out any data and there are no error's

I request you please send me the complete attachments i will download the path in to the desktop.
 

Attachments

  • PURCHASE ORDER YEAR OF 2017.zip
    134.3 KB · Views: 1
Dear Sir,

Its working fine. there is small correction in path i given wrongly

finally its working.

when i click the update data was pasted. second time i run the update same data again pasted its creating duplicate data.

Please see the attachment it should be paste same data in same cells until i add new IPO
 

Attachments

  • PURCHASE ORDER YEAR OF 2017.zip
    135.9 KB · Views: 10
Dear Sir,

Its working fine. there is small correction in path i given wrongly

finally its working.

when i click the update data was pasted. second time i run the update same data again pasted its creating duplicate data.

Please see the attachment it should be paste same data in same cells until i add new IPO
Hi,

Here you go... replace the code with the following:
Code:
Sub Update()

    Application.ScreenUpdating = False

    Dim StrFile, Wrkb As String
    Dim c As Range
   
    Wrkb = ActiveWorkbook.Name
    StrFile = Dir("J:\PURCHASE ORDER YEAR OF 2017\*IPO*")
   
    Rows("2:" & Cells(Rows.Count, "A").End(xlUp).Row + 1).ClearContents
   
    Do While Len(StrFile) > 0
        Workbooks.Open "J:\PURCHASE ORDER YEAR OF 2017\" & StrFile
       
            For Each c In ActiveWorkbook.Sheets("PURCHASE ORDER").Range("G10:G" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
                If IsNumeric(c) = True And c.Value > 0 Then
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("H4").Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("C4:E4").Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("J4").Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("C5:H5").Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("D6:E6").Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("C" & c.Row & ":F" & c.Row).Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("G" & c.Row).Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("H" & c.Row).Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("I" & c.Row).Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "J").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Workbooks(StrFile).Sheets("PURCHASE ORDER").Range("J" & c.Row).Copy
                    Workbooks(Wrkb).Sheets(1).Cells(Rows.Count, "S").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                End If
            Next c
       
        Workbooks(StrFile).Close savechanges:=False
        StrFile = Dir
    Loop

    Application.ScreenUpdating = True

End Sub

Let me know if it works.
 
Hi !

Another coding style :​
Code:
Sub YearImport()
       Const C = 19, P = 10, N = "PO No. "
         Dim L&, VP, F$, R&, VA(P To 33, 1 To C)
    With [A1].CurrentRegion
         L = .Rows.Count + 1
        VP = .Columns(1).Value
    End With
             Application.ScreenUpdating = False
             F = Dir(ThisWorkbook.Path & "\?" & N & "*.xlsm")
    Do Until F = ""
      If IsError(Application.Match(Val(Split(F, N)(1)), VP, 0)) Then
        With GetObject(ThisWorkbook.Path & "\" & F).Worksheets(1)
               R = .[I34].End(xlUp).Row
            If R >= P Then
            For R = P To R
                  VA(R, 1) = .[H4].Value
                  VA(R, 2) = .[C4].Value
                  VA(R, 3) = .[J4].Value
                  VA(R, 4) = .[C5].Value
                  VA(R, 5) = .[D6].Value
                  VA(R, 6) = .Cells(R, 3).Value
                  VA(R, 8) = .Cells(R, 7).Value
                  VA(R, 9) = .Cells(R, 8).Value
                 VA(R, 10) = .Cells(R, 9).Value
                 VA(R, 19) = .Cells(R, 10).Value
            Next
                 Cells(L, 1).Resize(R - P, C).Value = VA
                 L = L + R - P
            End If
                .Parent.Close False
        End With
      End If
             F = Dir
    Loop
             Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !
 
Sir,

its working.

i created new purchase order in the name of LPO not IPO the same thing i added in the code i am not getting both results


Wrkb = ActiveWorkbook.Name
StrFile = Dir("J:\PURCHASE ORDER YEAR OF 2017\*IPO*")
Wrkb = ActiveWorkbook.Name
StrFile = Dir("J:\PURCHASE ORDER YEAR OF 2017\*LPO*")
 

I just mod my code, try it and Like post #6 ‼​
Clean, I like it a lot :)

I never used GetObject before... what is the advantage over simply opening and closing the files? I'm assuming it is faster.

On a side note, (small contribution to your code) after testing you code I realized that it keeps prompting to save/discard the changes in the source files... since it is only copying data, we could just:
Code:
.Close savechanges:=False
 
Sir,

i tried both codes are working. when i update other columns data is erasing.
Ref columns are I,K,L,M,N,O,P,Q,R
what to do

Please help
 

Just move from source folder files yet imported !
Clean, I like it a lot :)

I never used GetObject before... what is the advantage over simply opening and closing the files? I'm assuming it is faster.

On a side note, (small contribution to your code) after testing you code I realized that it keeps prompting to save/discard the changes in the source files... since it is only copying data, we could just:
Code:
.Close savechanges:=False
Thanks !

GetObject function returns a reference on a workbook yet opened
or if it is closed opens it but hidden.
Not faster but avoiding a message or an error using Workbooks.Open
if the workbook is yet opened …

• On my side I do not have the prompt to save file as my code just read it,
maybe that belongs on Excel version … Code updated.
 
Sir,

i tried both codes are working. when i update other columns data is erasing.
Ref columns are I,K,L,M,N,O,P,Q,R
what to do

Please help
Hi,

That is because both @Marc L and I are clearing all the contents before starting to import the values from the files.

If you wish to keep the values from the mentioned columns, it can easily be done. Wouldn't that compromise the result though? I mean, you could end up with values on those columns that are not related to the data in the line.
I would only do it if those columns have formulas and not values.
Is that the case?
 

Last code update : try it and Like post #6 ‼ (where code is located)
It opens only PO NO files which are not in summary …

That means i want re-post new thread
No ‼ Just means try new code from post #6 and Like it !
 
Back
Top