Merge and Append 95 Workbooks into One Workbook

[pyrte]

I have scoured the internet for a quick solution to this problem, there are many questions that seem to ask the same thing I require but no answers I can see.

Microsoft knowledge base is useful, but unfortunately I can't seem to find a solution that applies to this particular case. Same with MrExcel, so if there is a thread I've missed that'll make my century!

_____

I have 95 workbooks
A total of about 3000 unique headers
Each worksheet has about 400 rows of data and anything from 6-58 columns
~160,000 rows of data total

As is probably clear from the fact that the number of columns varies, not all of the headers are consistent - but many are commonly occuring.

I found the consolidate tool, and this had the potential to make my task very simple, but the problem I have is it doesn't appear to have the option to simply append data.

For example, the simplest worksheet has headers:

Supplier (common to all - fixed position, Column A, repeating values)
Date (common to all - moves, repeating values)
Qty (common to all - moves, repeating values)
Low (common to all - moves, repeating values)
High (common to all - moves, repeating values)
Renew (only present in the very old worksheets but I wish to retain this column)


The most complicated has:

Supplier
ContactName
Tel1
Tel2
Add1
Add2
Add3
Add4
Add5
Added
LastActivity
Date
Qty
Low
High
RandomA (occassionally repeating values, not always present)
RandomB (occassionally repeating values, not always present)
...
(and more)


I need to combine these many worksheets so that ALL headers from ALL sheets are present in the consolidated worksheet and that the matching columns are appended into one huge worksheet.

Any help that you guys can offer is appreciated.

[snb]

Assuming
- all xlsx files
- all files in the same directory "G:\OF\"
- the result in sheet 'results'


Sub M_snb()
set d_00=createobject("scripting.dictionary")
sn=filter(split(createobject("wscript.shell").exec("cmd /c Dir G:\OF\*.xlsx /b/s").stdout.readall,vbcrlf),".")

for j=0 to ubound(sn)
with getobject(sn(j))
for each sh in .sheets
sp=sh.usedrange
sq=application.transpose(sp)

for jj=1 to ubound(sn,2)
d_00.item(sp(1,jj))= Replace(IIf(d_00.Item(sp(1, jj)) = "", "", d_00.Item(sp(1, jj)) & "|") & Join(Application.Index(sq, jj), "|"), "|" & sp(1, jj) & "|", "|")
next
next
.close 0
end with
next

For j = 0 To d_00.Count - 1
st = Split(d_00.Items()(j), "|")
sheets("results").Cells(1, j + 1).Resize(UBound(st) + 1) = Application.Transpose(st)
Next
End Sub

[SamT]

WOW! just wow!
The only way I can see to do it is have a list of all truly unique headers to start from. I really hope you did not mean that there are 3000 truly unique and different headers.

Since each Row in each Sheet in each Workbook is a different Record, you will wind up with a Worksheet with 58 to 80 columns and 160,000 Records/Rows.

[pyrte]

Thanks SNB, I updated the macro with the directory folder. where the excel files are stored. But when I run the macro. Nothing happens.

Here is what I did. Opened a new excel saved it as .xlsm and pasted the macro in the module of the workbook and run the macro with the updated directory.

[snb]

@SamT

As you can see: no big deal with Dictionaries.

[snb]

As I said you need a sheet 'results' in the same workbook that contains the macro.

And please show the adapted code.

I amended the code to:

Sub M_snb()
Set d_00=createobject("scripting.dictionary")
sn=filter(split(createobject("wscript.shell").exec("cmd /c Dir G:\OF\*.xlsx /b/s").stdout.readall,vbcrlf),".")

For j=0 To ubound(sn)
With getobject(sn(j))
For Each sh In .sheets
sp=sh.usedrange
sq=application.transpose(sp)

For jj=1 To ubound(sp,2)
d_00.item(sp(1,jj))= Replace(IIf(d_00.Item(sp(1, jj)) = "", "", d_00.Item(sp(1, jj)) & "|") & Join(Application.Index(sq, jj), "|"), "|" & sp(1, jj) & "|", "|")
Next
Next
.close 0
End With
Next

For j = 0 To d_00.Count - 1
st = Split(d_00.Items()(j), "|")
sheets("results").Cells(1, j + 1).Resize(UBound(st) + 1) = Application.Transpose(st)
Next
End Sub

[pyrte]

Sub M_snb()
Set d_00 = CreateObject("scripting.dictionary")
sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir C:\Users\exg21\Documents\Parts and Supplies Attributes\New folder *.xlsx /b/s").stdout.readall, vbCrLf), ".")

For j = 0 To UBound(sn)
With GetObject(sn(j))
For Each sh In .Sheets
sp = sh.UsedRange
sq = Application.Transpose(sp)

For jj = 1 To UBound(sn, 2)
d_00.Item(sn(1, jj)) = Replace(IIf(d_00.Item(sn(1, jj)) = "", "", d_00.Item(sn(1, jj)) & "|") & Join(Application.Index(sq, jj), "|"), "|" & sn(1, jj) & "|", "|")
Next
Next
.Close 0
End With
Next

For j = 0 To d_00.Count - 1
st = Split(d_00.Items()(j), "|")
Sheets("results").Cells(1, j + 1).Resize(UBound(st) + 1) = Application.Transpose(st)
Next
End Sub

[pyrte]

even after creating a page called results nothing happens.

[snb]

Please use code tags !

Apparently you overlooked the amended code.

Never use spaces in foldernames !

sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\exg21\Documents\Parts and Supplies Attributes\New folder\*.xlsx"" /b/s").stdout.readall, vbCrLf), ".")

[pyrte]

snb, I tried that and still nothing happens. I changed the path to

sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir C:\Users\exg21\ *.xlsx /b/s").stdout.readall, vbCrLf), ".")

I get a runtime error 432 at


With GetObject(sn(j))

[mancubus]

hi pyrte.
'mind the gap' :) (space) between \ and * in folder name.
why did you insrt it? a typo? or appeared so when you pasted the code here?