pulling data from multiple workbooks
Good call, I was just searching with the wrong keywords in my original search
but I found something that is doing the trick.
Code provided from Ron de Bruin
Sub Test_1()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim CalcMode As Long
'Fill in the path\folder where the files are
MyPath = "H:\myprojdir\GWIS\Humble\Test"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
BaseWks.Name = "wertyu"
'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
mybook.Worksheets.Copy _
after:=BaseWks.Parent.Sheets(BaseWks.Parent.Sheets .Count)
End If
mybook.Close savechanges:=False
Next Fnum
Application.DisplayAlerts = False
BaseWks.Delete
Application.DisplayAlerts = True
End If
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
"Sheeloo" wrote:
Copied from another post...
[Subject: how to combine several files, all with same columns, into one
shee 7/11/2006 5:35 AM PST
By: Bernie Deitrick In: microsoft.public.excel.misc ]
Assumptions a data starts in cell A1, the table is contiguous, is on the
first sheet of the
workbook, and all 100 files are in one folder. Also, the total in all files
is less than 65536 rows
of data.
Copy the macro below into a codemodule of a new workbook, change the path
where indicated, and run
it. When it is done, save the workbook.
HTH,
Bernie
MS Excel MVP
Sub Consolidate()
Dim myBook As Workbook
Dim myCalc As XlCalculation
Dim myShtName As String
With Application
.EnableEvents = False
.DisplayAlerts = False
myCalc = .Calculation
.Calculation = xlCalculationManual
End With
On Error Resume Next
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\Excel\Files to combine"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets(1).Range("A1").CurrentRegion.Cop y _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2 )
myBook.Close False
Next i
Else: MsgBox "There were no files found."
End If
End With
With Application
.EnableEvents = True
.DisplayAlerts = True
.Calculation = myCalc
End With
End Sub
"James" wrote:
I have something on the range of 50 or so different workbooks. There are
multiple worksheets within these workbooks, but I am only concerned with
Sheet1. Is there a way to compile all these different Sheet1's into one
single work book and pasting them as values. All the workbooks of intrest
reside in the same folder so there are no subfolders.
Thanks for any help.
|