Need help editing this code
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
|