The first problem I get is this, see code in red below.
I do believe the rest of the errors I get is of similar type.
"Error: "Run time '438', Objet doesn't support this property or
method." (see more info in code below)
Thanks,
Ctech Wrote:
Macro:
Dim sFileBase As String
Dim sFilename As String
Private Sub cmd_OK_Click()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim mRows As Long
Dim mSheet As String
Dim mCostCenter
Dim mRange
' Application.ScreenUpdating = False
' Application.DisplayAlerts = False
' Application.EnableEvents = False
Set wbCodeBook = ThisWorkbook
' Set active Cell
Range("A4").Select
mAddress = GetFromWorkbook.Txt_Address.Text
mRange = GetFromWorkbook.RefEdit_Range.Text
mSheet = GetFromWorkbook.Txt_Sheet.Text
mCostCenter = GetFromWorkbook.RefEdit_mCostCenter.Text
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = mAddress & "\"
.FileType = msoFileTypeExcelWorkbooks
'.Filename = "Book*.xls"
If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults =
Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'--------------- CODE HERE ------------------
' If the Sheet exist then
If SheetExists(mSheet, wbResults)
Then
' Activate Workbook
' Application.wbCodeBook.Activate
' Cost center in Column A
' If Not mCostCenter Is Nothing
Then
' ActiveCell =
Application.wbResults.Sheets(mSheet).Range(mCostCe nter)
' End If
' Copy Capital expenditure numbers
Application.wbResults.Sheets(mSheet).Range(mRange) .Select
*** ***Above code gives me an error: "Run time '438', Objet doesn't
support this property or method. *******
' Count the number of rows in the
range
mRows =
Application.wbResults.Sheets(mSheet).Range(mRange) .Rows.Count
Selection.Copy
' Activate and paste the workbook
range to sheet
Application.wbCodeBook.Activate
ActiveCell.Offset(0,
1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveCell.Offset(0, -1).Select
' Set activeCell of next workbook
ActiveCell.Offset(mRows, 0).Select
' Delete Copied area for memory
Application.CutCopyMode = False
End If
'-------- END -- CODE HERE -- END ------------
' Do not save changes in opened workbooks
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
' Close the UserForm
Unload GetFromWorkbook
End Sub
'-----------------------------------------------------------------
Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Function
Private Sub cmd_Cancel_Click()
Unload GetFromWorkbook
End Sub
--
Ctech
------------------------------------------------------------------------
Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
View this thread:
http://www.excelforum.com/showthread...hreadid=486170