View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Ctech[_51_] Ctech[_51_] is offline
external usenet poster
 
Posts: 1
Default Get a Range from all wk in a folder...


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