If SheetExisit then

[Ctech]

I've been getting some help on this macro, however I still can't get it to work.
So I have now simplified it a bit.

What the macro is to do:

1. Open all the workbooks in the specified folder. (one at a time) (For i = 1 To 850)
2. "If SheetExists("Sch 20", Aworkbook) Then"
3. If the Workbook contains a worksheet "Sch 20", then copy range..


Problems is:

2. "If SheetExists("Sch 20", Aworkbook) Then"

This part doesn't work. However I don't know why? Can it have something to do with my error handler?



Macro:

Option Explicit

Sub GetCellsFromWorkbooks()
Dim Mnumb
Dim Aworkbook As Workbook
Dim AWorkbook3
Dim sFileBase As String
Dim sFilename As String
Dim i
Dim Mcount As Long



AWorkbook3 = ActiveWorkbook.Name
Mnumb = 102
Range("A8").Select

For i = 1 To 850

On Error GoTo Errorhandler

' Set active Cell to Costcenter number / budget pack number

ActiveCell.Value = Mnumb

' Folder

sFileBase = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
"Budget packs - Capital expenditure - comments\LBUD2\BFR " & _
Mnumb
sFilename = sFileBase & " bud v2.1.xls"

' Open Pack

Set Aworkbook = Workbooks.Open(Filename:=sFilename, UpdateLinks:=0)

' If the opened workbook, contains the specified sheet then do...

If SheetExists("Sch 20", Aworkbook) Then

Aworkbook.Sheets("Sch 20").Range("A1:E25").Select
Mcount = Selection.Count


Selection.Copy

' Go to workbook where the macro was ran, and paste range

Workbooks(AWorkbook3).ActiveCell.Offset(0, 1).Paste

ActiveCell.Offset(5, -1).Select


Aworkbook.Close
Application.CutCopyMode = False

End If

Mnumb = Mnumb + 1
Next i

Errorhandler:

Mnumb = Mnumb + 1

Resume

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

[Norman Jones]

Hi Ctech,

> Aworkbook.Sheets("Sch 20").Range("A1:E25").Select

It is not possible to make selections on a non-active sheet.

It is rarely necessary, or desirable to make selections, but if you wish to,
try activating the sheet first:

Aworkbook.Sheets("Sch 20").Activate

---
Regards,
Norman



"Ctech" <[email protected]> wrote in message
news:[email protected]...
>
> I've been getting some help on this macro, however I still can't get it
> to work.
> So I have now simplified it a bit.
>
> WHAT THE MACRO IS TO DO:
>
> 1. Open all the workbooks in the specified folder. (one at a time) (For
> i = 1 To 850)
> 2. "If SheetExists("Sch 20", Aworkbook) Then"
> 3. If the Workbook contains a worksheet "Sch 20", then copy range..
>
>
> PROBLEMS IS:
>
> 2. "If SheetExists("Sch 20", Aworkbook) Then"
>
> This part doesn't work. However I don't know why? Can it have something
> to do with my error handler?
>
>
>
> MACRO:
>
> Option Explicit
>
> Sub GetCellsFromWorkbooks()
> Dim Mnumb
> Dim Aworkbook As Workbook
> Dim AWorkbook3
> Dim sFileBase As String
> Dim sFilename As String
> Dim i
> Dim Mcount As Long
>
>
>
> AWorkbook3 = ActiveWorkbook.Name
> Mnumb = 102
> Range("A8").Select
>
> For i = 1 To 850
>
> On Error GoTo Errorhandler
>
> ' Set active Cell to Costcenter number / budget pack number
>
> ActiveCell.Value = Mnumb
>
> ' Folder
>
> sFileBase = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
> "Budget packs - Capital expenditure - comments\LBUD2\BFR " & _
> Mnumb
> sFilename = sFileBase & " bud v2.1.xls"
>
> ' Open Pack
>
> Set Aworkbook = Workbooks.Open(Filename:=sFilename, UpdateLinks:=0)
>
> ' If the opened workbook, contains the specified sheet then do...
>
> If SheetExists("Sch 20", Aworkbook) Then
>
> Aworkbook.Sheets("Sch 20").Range("A1:E25").Select
> Mcount = Selection.Count
>
>
> Selection.Copy
>
> ' Go to workbook where the macro was ran, and paste range
>
> Workbooks(AWorkbook3).ActiveCell.Offset(0, 1).Paste
>
> ActiveCell.Offset(5, -1).Select
>
>
> Aworkbook.Close
> Application.CutCopyMode = False
>
> End If
>
> Mnumb = Mnumb + 1
> Next i
>
> Errorhandler:
>
> Mnumb = Mnumb + 1
>
> Resume
>
> 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
>
>
> --
> Ctech
> ------------------------------------------------------------------------
> Ctech's Profile:
> http://www.excelforum.com/member.php...o&userid=27745
> View this thread: http://www.excelforum.com/showthread...hreadid=484789
>

[Ctech]

It works now..


Option Explicit

Sub GetCellsFromWorkbooks()
Dim Mnumb
Dim Aworkbook As Workbook
Dim AWorkbook3
Dim sFileBase As String
Dim sFilename As String
Dim i
Dim Mcount As Long



AWorkbook3 = ActiveWorkbook.Name
Mnumb = 102
Range("A8").Select

For i = 1 To 850

On Error GoTo Errorhandler

' Set active Cell to Costcenter number / budget pack number

ActiveCell.Value = Mnumb

' Folder

sFileBase = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
"Budget packs - Capital expenditure - comments\LBUD2\BFR " & _
Mnumb
sFilename = sFileBase & " bud v2.1.xls"

' Open Pack

Set Aworkbook = Workbooks.Open(Filename:=sFilename, UpdateLinks:=0)



' If the opened workbook, contains the specified sheet then do...

If SheetExists("Sch 20", Aworkbook) Then

Aworkbook.Sheets("Sch 20").Activate
Aworkbook.Sheets("Sch 20").Range("A1:E25").Select
Mcount = Selection.Rows.Count


Selection.Copy

' Go to workbook where the macro was ran, and paste range

Application.Workbooks(AWorkbook3).Activate
ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False



End If
ActiveCell.Offset(Mcount, -1).Select
Application.CutCopyMode = False
Aworkbook.Close




Mnumb = Mnumb + 1
Next i

Errorhandler:
Application.CutCopyMode = False


Mnumb = Mnumb + 1

Resume Next

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