LinkBack URL
About LinkBacks
Hi
I have a macro which worked previously, however it seams to have some sort of problem. but I can't figure out whats causing it.
Im getting this error: "Error 438 - Object doesn't support property or method"
on this part of the macro : Application.wbResults.Sheets(mSheet).Range(mRange).Select
All of the macro:
Dim sFileBase As String
Dim sFilename As String
Sub Kkkemen()
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 = "X:\Data\OLAP\Budgets UK\Budgets - 2005\test"
mRange = "C10"
mSheet = "Sch 5"
mCostCenter = "101"
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
' 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
Register To Reply
Bookmarks