Advanced Macro to Combine Info from Multiple Workbooks into One Workbook

G

Gronk_h8er

Board Regular
Joined
Jan 6, 2009
Messages
63
Hi All,

You helped me a while ago putting together a macro in the thread, "Combining Multiple Cells in Multiple Worksheets in Multiple Workbooks into one Table", which, as the thread name indicates, collected specific cells from multiple workbooks and put them into one workbook for me.

I know have a similar issue that expands upon this idea, yet seems to me be slightly more difficult.

Whereas originally, the cells being pulled each time where the same in each workbook, i now need to create a macro that will look into a workbook and pull the names of multiple sheets for use as headings, and pull cells from an array that will be different in size for each workbook.

This is quite tricky to explain in words and i wish i could show you, but i don't know how.

Maybe first things first, how can i change the original macro, listed below, to look at the names of the worksheets and pull them as headings for my report?

Please tell me anything you need that will make this easier for you! I will do my best to accomodate.

I really appreciate any help you can give me!

Sub test()
Dim myDir As String, fn As String, temp As String, ref As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
myDir = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
n = 2
fn = Dir(myDir & "*.xls*")
Do While fn <> ""
If fn <> ThisWorkbook.Name Then
n = n + 1: temp = "='" & myDir & "[" & fn & "]"
With ThisWorkbook.Sheets("sheet1") '<- change to actual sheet name
ref = temp & "Cover Sheet'!"
.Cells(n, "a").Formula = ref & "D7"
ref = temp & "Value-Ease'!"
.Cells(n, "b").Resize(, 3).Formula = _
Array(ref & "F10", ref & "F23", ref & "L26")
.Cells(n, "k").Resize(, 4).Formula = _
Array(ref & "F10", ref & "F14", ref & "F16", ref & "F10")
ref = temp & "Strategic Supply Positioning'!"
.Cells(n, "e").Resize(, 6).Formula = _
Array(ref & "F14", ref & "F12", ref & "F32", ref & "F34", _
ref & "R35", ref & "F30")
.Cells(n, "o").Resize(, 4).Formula = _
Array(ref & "F20", ref & "F18", ref & "F26", ref & "F28")
ref = temp & "Potential Options'!"
.Cells(n, "t").Resize(, 40).Formula = _
Array(ref & "I14", ref & "I15", ref & "I16", ref & "I17", ref & "I18", ref & "I19", ref & "I20", ref & "I21", ref & "I22", ref & "I23", ref & "I24", ref & "I25", ref & "I26", ref & "I27", ref & "I28", ref & "I29", ref & "I30", ref & "I31", ref & "F43", ref & "F44", ref & "F45", ref & "F46", ref & "F47", ref & "F48", ref & "F49", ref & "F50", ref & "F51", ref & "F53", ref & "F54", ref & "F55", ref & "F57", ref & "F58", ref & "F60", ref & "F61", ref & "F63", ref & "F64", ref & "F65", ref & "F66", ref & "F67", ref & "F68")
.Rows(1).Value = .Rows(1).Value
End With
End If
fn = Dir
Loop
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
Hi
save the following codes in a workbook and name it as listA1. and run the macro.
Code: 
Sub Pull()
Dim a As Long, x As Long, c As Long, e As Long, d As Long, y As Long
Dim f As String, b As String
Cells.ClearContents
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Application.DisplayAlerts = False
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
x = Workbooks("listA1.xls").Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
d = x + 2
For a = 2 To x
b = Workbooks("ListA1").Worksheets("sheet1").Cells(a, 1)
If b <> "ListA1.xls" Then
Workbooks.Open Filename:=Workbooks("ListA1").Worksheets("sheet1").Cells(1, 2) & b
y = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Workbooks("listA1").Worksheets("Sheet1").Cells(d, 1) = b
For c = 1 To Sheets.Count
Workbooks("listA1").Worksheets("Sheet1").Cells(d, 2) = Workbooks(b).Worksheets(c).Name
Workbooks("listA1").Worksheets("Sheet1").Cells(d, 3) = Workbooks(b).Worksheets(c).Cells(1, 1)
d = d + 1
Next c
ActiveWorkbook.Close False
End If
Next a
Application.DisplayAlerts = True
MsgBox "collating is complete."
End Sub
It pulls all file names and their sheet names and value of A1 from each sheet
Ravi
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Copy Multiple Tabs to a new workbook
Replies
9
Views
355
skillilea
S
B
  • Question
populating the next available row in a shared workbook
Replies
1
Views
261
rondeondo
rondeondo
J
  • Solved
Calculate last 5 soccer team goals using data from another sheet on same workbook.
2
Replies
19
Views
908
felixstraube
F
P
  • Question
2D spilled array, using REDUCE and INDIRECT to consolidate data from multiple sheets.
Replies
5
Views
276
Fluff
Fluff
B
  • Question
Add new Row in ListObject Table with data from an Array
Replies
4
Views
93
Akuini
Akuini

Forum statistics

Threads
1,215,043
Messages
6,122,812
Members
449,095
Latest member
m_smith_solihull

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top