View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Ctech[_89_] Ctech[_89_] is offline
external usenet poster
 
Posts: 1
Default For all workbooks in a folder


Hi

I have a macro which worked previously, however it seams to have som
sort of problem. but I can't figure out whats causing it.

Im getting this error: "Error 438 - Object doesn't support property o
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(mCostC
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 Su

--
Ctec

-----------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...fo&userid=2774
View this thread: http://www.excelforum.com/showthread.php?threadid=50629