This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again

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
with mybook.worksheets("reports")
'convert to values (in place
.cells.copy
.cells.pastespecial paste:=xlpastevalues

.Copy _
after:=BaseWks.Parent.Sheets _
(BaseWks.Parent.Sheets.Count)
end with
on error goto 0
End If
mybook.Close savechanges:=False

Next Fnum
Application.DisplayAlerts = False
BaseWks.Delete
Application.DisplayAlerts = True
End If

It converts the formulas to values in the just opened workbook, but since you
close without saving, it shouldn't do any harm.

Untested, uncompiled. Watch for typos!

James wrote:

This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again

--

Dave Peterson

James, I've used the following code to accomplish a task similar to what you
are seeking to do. I have modified the code to reflect your particulars.

Option Explicit

Sub GetReportsDataOnly()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String

myExistingPath = CurDir
myPathToRetrieve = "H:\myprojdir\GWIS\Humble\Test"
ChDrive myPathToRetrieve
ChDir myPathToRetrieve

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Reports")
On Error Resume Next
Set mybook = Workbooks.Open(.FoundFiles(i))
mybook.Close SaveChanges:=False
.UsedRange.Value = .UsedRange.Value
.Copy
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End If

'reset it back
ChDrive myExistingPath
ChDir myExistingPath

End Sub

Hope this helps you. Do post back if this fails to achieve what you want.

Best Wishes,
Mike

"James" wrote:

This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again

Mike,
It looks like there is an error with this line

after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
I get an error as followed: Compile error: Expected: expression

Not sure where it needs to be at.

"MikeT" wrote:

James, I've used the following code to accomplish a task similar to what you
are seeking to do. I have modified the code to reflect your particulars.

Option Explicit

Sub GetReportsDataOnly()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String

myExistingPath = CurDir
myPathToRetrieve = "H:\myprojdir\GWIS\Humble\Test"
ChDrive myPathToRetrieve
ChDir myPathToRetrieve

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Reports")
On Error Resume Next
Set mybook = Workbooks.Open(.FoundFiles(i))
mybook.Close SaveChanges:=False
.UsedRange.Value = .UsedRange.Value
.Copy
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End If

'reset it back
ChDrive myExistingPath
ChDir myExistingPath

End Sub

Hope this helps you. Do post back if this fails to achieve what you want.

Best Wishes,
Mike

"James" wrote:

This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again

Dave,
This works great. This is going to save me a lot of time and who knows I may
be able to get out of here on time.

Very grateful,
James



"Dave Peterson" wrote:

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
with mybook.worksheets("reports")
'convert to values (in place
.cells.copy
.cells.pastespecial paste:=xlpastevalues

.Copy _
after:=BaseWks.Parent.Sheets _
(BaseWks.Parent.Sheets.Count)
end with
on error goto 0
End If
mybook.Close savechanges:=False

Next Fnum
Application.DisplayAlerts = False
BaseWks.Delete
Application.DisplayAlerts = True
End If

It converts the formulas to values in the just opened workbook, but since you
close without saving, it shouldn't do any harm.

Untested, uncompiled. Watch for typos!

James wrote:

This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again

--

Dave Peterson

James,
I will test the code I posted for you and repost. I made a modification to
accomodate your situation and did not have time to test it first. I'll
repost shortly after I can troubleshoot the compile error. Keep smiling...

BTW - Dave Peterson, like Ron de Bruin, is an expert. Anything you see
posted by either of them is worth studying for learning purposes. They are
amazing.

Stay tuned. Mike

"James" wrote:

Mike,
It looks like there is an error with this line

after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
I get an error as followed: Compile error: Expected: expression

Not sure where it needs to be at.

"MikeT" wrote:

James, I've used the following code to accomplish a task similar to what you
are seeking to do. I have modified the code to reflect your particulars.

Option Explicit

Sub GetReportsDataOnly()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String

myExistingPath = CurDir
myPathToRetrieve = "H:\myprojdir\GWIS\Humble\Test"
ChDrive myPathToRetrieve
ChDir myPathToRetrieve

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Reports")
On Error Resume Next
Set mybook = Workbooks.Open(.FoundFiles(i))
mybook.Close SaveChanges:=False
.UsedRange.Value = .UsedRange.Value
.Copy
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End If

'reset it back
ChDrive myExistingPath
ChDir myExistingPath

End Sub

Hope this helps you. Do post back if this fails to achieve what you want.

Best Wishes,
Mike

"James" wrote:

This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again

"James" wrote:

Mike,
It looks like there is an error with this line

after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
I get an error as followed: Compile error: Expected: expression

Not sure where it needs to be at.

"MikeT" wrote:

James, I've used the following code to accomplish a task similar to what you
are seeking to do. I have modified the code to reflect your particulars.

Option Explicit

Sub GetReportsDataOnly()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String

myExistingPath = CurDir
myPathToRetrieve = "H:\myprojdir\GWIS\Humble\Test"
ChDrive myPathToRetrieve
ChDir myPathToRetrieve

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Reports")
On Error Resume Next
Set mybook = Workbooks.Open(.FoundFiles(i))
mybook.Close SaveChanges:=False
.UsedRange.Value = .UsedRange.Value
.Copy
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End If

'reset it back
ChDrive myExistingPath
ChDir myExistingPath

End Sub

Hope this helps you. Do post back if this fails to achieve what you want.

Best Wishes,
Mike

"James" wrote:

This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again

James,

I beleive the compilation error was caused by a line of code that was copied
as two separate lines rather than one.

..Copy
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)

should be all on the same line, like this:
..Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)

I tested the code and it did work for me. However, since Dave Peterson's
solution solved your issue, you may decide to not even give this another try.
No worries, but I wanted to repost the code that I tested for you anyway.
Glad you found the solution you were seeking.

Mike

"James" wrote:

Mike,
It looks like there is an error with this line

after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
I get an error as followed: Compile error: Expected: expression

Not sure where it needs to be at.

"MikeT" wrote:

James, I've used the following code to accomplish a task similar to what you
are seeking to do. I have modified the code to reflect your particulars.

Option Explicit

Sub GetReportsDataOnly()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String

myExistingPath = CurDir
myPathToRetrieve = "H:\myprojdir\GWIS\Humble\Test"
ChDrive myPathToRetrieve
ChDir myPathToRetrieve

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Reports")
On Error Resume Next
Set mybook = Workbooks.Open(.FoundFiles(i))
mybook.Close SaveChanges:=False
.UsedRange.Value = .UsedRange.Value
.Copy
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End If

'reset it back
ChDrive myExistingPath
ChDir myExistingPath

End Sub

Hope this helps you. Do post back if this fails to achieve what you want.

Best Wishes,
Mike

"James" wrote:

This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again

Mike,
Thanks for the edit and it now works too. I have saved both codes and I am
sure it will help me again sooner or later.

Thanks again,
James

"MikeT" wrote:

James,

I beleive the compilation error was caused by a line of code that was copied
as two separate lines rather than one.

.Copy
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)

should be all on the same line, like this:
.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)

I tested the code and it did work for me. However, since Dave Peterson's
solution solved your issue, you may decide to not even give this another try.
No worries, but I wanted to repost the code that I tested for you anyway.
Glad you found the solution you were seeking.

Mike

"James" wrote:

Mike,
It looks like there is an error with this line

after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
I get an error as followed: Compile error: Expected: expression

Not sure where it needs to be at.

"MikeT" wrote:

James, I've used the following code to accomplish a task similar to what you
are seeking to do. I have modified the code to reflect your particulars.

Option Explicit

Sub GetReportsDataOnly()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String

myExistingPath = CurDir
myPathToRetrieve = "H:\myprojdir\GWIS\Humble\Test"
ChDrive myPathToRetrieve
ChDir myPathToRetrieve

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Reports")
On Error Resume Next
Set mybook = Workbooks.Open(.FoundFiles(i))
mybook.Close SaveChanges:=False
.UsedRange.Value = .UsedRange.Value
.Copy
after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End If

'reset it back
ChDrive myExistingPath
ChDir myExistingPath

End Sub

Hope this helps you. Do post back if this fails to achieve what you want.

Best Wishes,
Mike

"James" wrote:

This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to
only pull the worksheets called "Reports", and when it copies it to the new
workbook I need it to copy it as values. This code was provided from an
earlier post 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
'Sheets("Report").Select

'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

Thanks again