error when sheet doesn't exist...

[Ctech]

My macro opens all workbooks in a specified folder and copies a range from a certain sheet. However I have now a problem as not all of the workbooks contains worksheet "Sch 7A".

How can I add an error handler which so something like this..

If sheet doen't exsisit, then goto next workbook.

My macro:

Sub GetCellsFromWorkbooks()
'
' Macro1 Macro
' Macro recorded 31/10/2005 by Taylor Nelson Sofres plc
'

'

Dim Mnumb
Dim Aworkbook
Dim Aworkbook2
Dim AWorkbook3

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

' On Error GoTo Errorhandler

For i = 1 To 850

Application.Workbooks.Open Filename:= _
"X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs - Capital expenditure - comments\Test\BFR " & Mnumb & " bud v2.1.xls" _
, UpdateLinks:=0


Aworkbook = Workbooks("BFR " & Mnumb & " bud v2.1.xls").Name

' Taken out the save without password bit

'Application.DisplayAlerts = False
'
' ActiveWorkbook.SaveAs FileName:= _
' "X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs - Capital expenditure - comments\" & Aworkbook _
' , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
' ReadOnlyRecommended:=False, CreateBackup:=False

' Set cost center name


Workbooks.Add.Activate

ActiveWorkbook.SaveAs Filename:= _
"X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs - Capital expenditure - comments\Test\BFR " & Mnumb & " bud v2.1-2.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Aworkbook2 = Workbooks("BFR " & Mnumb & " bud v2.1-2.xls").Name



ActiveCell = Mnumb



' All sheets

Dim Morg
Dim Mto

Morg = Lbud.TextBox_org
Mto = Lbud.TextBox_to

Dim Sht As Worksheet

On Error Resume Next

For Each Sht In Worksheets
Application.Workbooks(Aworkbook).Sheets("Sch 7A").Range("A1:X250").Select
Selection.Copy

Application.Workbooks(Aworkbook2).Select
Application.Workbooks(Aworkbook2).Sheets.Add
ActiveSheet.Range("A1").Select
ActiveSheet.Paste

Next

On Error GoTo 0




' Select cell for next i + 1

Application.CutCopyMode = False

' ActiveWorkbook.SaveAs Filename:= _
"X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs - Capital expenditure - comments\Test\BFR " & Mnumb & " bud v2.1-2.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


Application.Workbooks("BFR " & Mnumb & " bud v2.1.xls").Close

Application.CutCopyMode = False


Mnumb = Mnumb + 1
Next i

Errorhandler:

Mnumb = Mnumb + 1

Resume


End Sub

[Bob Phillips]

Use this function


'-----------------------------------------------------------------
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


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Ctech" <[email protected]> wrote in
message news:[email protected]...
>
> My macro opens all workbooks in a specified folder and copies a range
> from a certain sheet. However I have now a problem as not all of the
> workbooks contains worksheet "Sch 7A".
>
> How can I add an error handler which so something like this..
>
> If sheet doen't exsisit, then goto next workbook.
>
> My macro:
>
> Sub GetCellsFromWorkbooks()
> '
> ' Macro1 Macro
> ' Macro recorded 31/10/2005 by Taylor Nelson Sofres plc
> '
>
> '
>
> Dim Mnumb
> Dim Aworkbook
> Dim Aworkbook2
> Dim AWorkbook3
>
> AWorkbook3 = Application.ActiveWorkbook.Name
> Mnumb = 101
> Range("A8").Select
>
> ' On Error GoTo Errorhandler
>
> For i = 1 To 850
>
> Application.Workbooks.Open Filename:= _
> "X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs -
> Capital expenditure - comments\Test\BFR " & Mnumb & " bud v2.1.xls" _
> , UpdateLinks:=0
>
>
> Aworkbook = Workbooks("BFR " & Mnumb & " bud v2.1.xls").Name
>
> ' Taken out the save without password bit
>
> 'Application.DisplayAlerts = False
> '
> ' ActiveWorkbook.SaveAs FileName:= _
> ' "X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs -
> Capital expenditure - comments\" & Aworkbook _
> ' , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
> ' ReadOnlyRecommended:=False, CreateBackup:=False
>
> ' Set cost center name
>
>
> Workbooks.Add.Activate
>
> ActiveWorkbook.SaveAs Filename:= _
> "X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs -
> Capital expenditure - comments\Test\BFR " & Mnumb & " bud v2.1-2.xls"
> _
> , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
> ReadOnlyRecommended:=False, CreateBackup:=False
>
> Aworkbook2 = Workbooks("BFR " & Mnumb & " bud v2.1-2.xls").Name
>
>
>
> ActiveCell = Mnumb
>
>
>
> ' All sheets
>
> Dim Morg
> Dim Mto
>
> Morg = Lbud.TextBox_org
> Mto = Lbud.TextBox_to
>
> Dim Sht As Worksheet
>
> On Error Resume Next
>
> For Each Sht In Worksheets
> Application.Workbooks(Aworkbook).Sheets("Sch
> 7A").Range("A1:X250").Select
> Selection.Copy
>
> Application.Workbooks(Aworkbook2).Select
> Application.Workbooks(Aworkbook2).Sheets.Add
> ActiveSheet.Range("A1").Select
> ActiveSheet.Paste
>
> Next
>
> On Error GoTo 0
>
>
>
>
> ' Select cell for next i + 1
>
> Application.CutCopyMode = False
>
> ' ActiveWorkbook.SaveAs Filename:= _
> "X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs -
> Capital expenditure - comments\Test\BFR " & Mnumb & " bud v2.1-2.xls"
> _
> , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
> ReadOnlyRecommended:=False, CreateBackup:=False
>
>
> Application.Workbooks("BFR " & Mnumb & " bud v2.1.xls").Close
>
> Application.CutCopyMode = False
>
>
> Mnumb = Mnumb + 1
> Next i
>
> Errorhandler:
>
> Mnumb = Mnumb + 1
>
> Resume
>
>
> End Sub
>
>
> --
> Ctech
> ------------------------------------------------------------------------
> Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
> View this thread: http://www.excelforum.com/showthread...hreadid=483865
>

[Ctech]

How do I implement this function in my macro?

[Ctech]

How can I use Bob's function (over ) to work with my macro?

Never used functions before..

[Bob Phillips]

I think that it would be with this code

For i = 1 To 850

Application.Workbooks.Open Filename:= _
"X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs -Capital
expenditure - comments\Test\BFR " & Mnumb & " bud v2.1.xls" _
, UpdateLinks:=0

Aworkbook = Workbooks("BFR " & Mnumb & " bud v2.1.xls").Name


Firstly, I think you should open the file outside of the loop, then test for
existence, exit if not found


sFilename = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
"Budget packs - Capital expenditure - comments\Test\BFR
" & _
Mnumb & " bud v2.1.xls"
Application.Workbooks.Open Filename:= sFilename, UpdateLinks:=0

If Not SheetExists("Sch 7A") Then Exit Sub

Aworkbook = Activeworkbook.Name

For i = 1 To 850

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Ctech" <[email protected]> wrote in
message news:[email protected]...
>
> How do I implement this function in my macro?
>
>
> --
> Ctech
> ------------------------------------------------------------------------
> Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
> View this thread: http://www.excelforum.com/showthread...hreadid=483865
>

[Ctech]

Can't get it to work..

Sub GetCellsFromWorkbooks()
'
' Macro1 Macro
' Macro recorded 31/10/2005 by Taylor Nelson Sofres plc
'

'

Dim Mnumb
Dim Aworkbook
Dim ActiveWorkbook
Dim SFilename

ActiveWorkbook = Application.ActiveWorkbook.Name
Mnumb = 101


Range("A9").Select

On Error GoTo Errorhandler

For i = 1 To 850

Application.Workbooks.Open Filename:= _
"X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs - Capital expenditure - comments\LBUD2\BFR " & Mnumb & " bud v2.1.xls" _
, UpdateLinks:=0

Aworkbook = Workbooks("BFR " & Mnumb & " bud v2.1.xls").Name

' Taken out the save without password bit

'Application.DisplayAlerts = False
'
' ActiveWorkbook.SaveAs FileName:= _
' "X:\Users\Shared\GENERAL\Christian S\05.10.28 - Budget packs - Capital expenditure - comments\" & Aworkbook _
' , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
' ReadOnlyRecommended:=False, CreateBackup:=False

' Set cost center name


Application.Workbooks(ActiveWorkbook).Activate
ActiveCell = Mnumb



' Copy Capital expenditure numbers

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

Application.Workbooks.Open Filename:=SFilename, UpdateLinks:=0

If Not SheetExists("Sch 20") Then GoTo Errorhandler





Application.Workbooks(Aworkbook).Sheets("Sch 20").Range("A11:G25").Copy

' Activate the workbook which the cells are saved in

Application.Workbooks(ActiveWorkbook).Activate
ActiveCell.Offset(0, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveCell.Offset(0, -2).Select



' Select cell for next i + 1

ActiveCell.Offset(14, 0).Select

Application.CutCopyMode = False
Application.Workbooks("BFR " & Mnumb & " bud v2.1.xls").Close
Application.CutCopyMode = False


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

[Bob Phillips]

Don't if this is any different, but I have tested it best I can and it seems
to work

Sub GetCellsFromWorkbooks()
Dim Mnumb
Dim Aworkbook As Workbook
Dim Aworkbook2 As Workbook
Dim AWorkbook3 As Workbook
Dim sFileBase As String
Dim sFilename As String
Dim Morg
Dim Mto
Dim Sht As Worksheet

Set AWorkbook3 = ActiveWorkbook
Mnumb = 101
Range("A8").Select

sFileBase = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
"Budget packs - Capital expenditure - comments\Test\BFR" & _
Mnumb
sFilename = sFileBase & " bud v2.1.xls"
Set Aworkbook = Workbooks.Open(Filename:=sFilename, UpdateLinks:=0)

If Not SheetExists("Sch 7A", Aworkbook) Then Exit Sub

For i = 1 To 850

Set Aworkbook2 = Workbooks.Add

Aworkbook2.SaveAs Filename:=sfgilebase & " bud v2.1-2.xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Aworkbook2.Activate
ActiveCell = Mnumb

Morg = Lbud.TextBox_org
Mto = Lbud.TextBox_to

On Error Resume Next

For Each Sht In Worksheets
Aworkbook.Sheets("Sch 7A").Range("A1:X250").Select
Selection.Copy
Aworkbook2.Select
Aworkbook2.Sheets.Add
ActiveSheet.Range("A1").Select
ActiveSheet.Paste
Next

On Error GoTo 0

Aworkbook.Close

Application.CutCopyMode = False

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





--

HTH

RP
(remove nothere from the email address if mailing direct)


"Ctech" <[email protected]> wrote in message
news:[email protected]...
>
> How can I use Bob's function (over ) to work with my macro?
>
> Never used functions before..
>
>
> --
> Ctech
> ------------------------------------------------------------------------
> Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
> View this thread: http://www.excelforum.com/showthread...hreadid=483865
>

[Ctech]

The macro doesn't work as I want it to.

The macro you wrote terminates when the workbook doesn't contain the specified sheet. But I want it then to close the workbook and try the next workbook.


How can I do this?

[Bob Phillips]

How does it know what the 'next' workbook is?

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Ctech" <[email protected]> wrote in
message news:[email protected]...
>
> The macro doesn't work as I want it to.
>
> The macro you wrote terminates when the workbook doesn't contain the
> specified sheet. But I want it then to close the workbook and try the
> next workbook.
>
>
> How can I do this?
>
>
> --
> Ctech
> ------------------------------------------------------------------------
> Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
> View this thread: http://www.excelforum.com/showthread...hreadid=483865
>

[Ctech]

All the files in the specified folder have the same name except one number


This part opend the files:

' start number of file name

Mnumb = 101

' When the file doesn't exist

On Error GoTo Errorhandler


For i = 1 To 850

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

Application.Workbooks.Open Filename:=SFilename, UpdateLinks:=0

[Bob Phillips]

Option Explicit

Sub GetCellsFromWorkbooks()
Dim Mnumb
Dim Aworkbook As Workbook
Dim Aworkbook2 As Workbook
Dim AWorkbook3 As Workbook
Dim sFileBase As String
Dim sFilename As String
Dim Morg
Dim Mto
Dim Sht As Worksheet

Set AWorkbook3 = ActiveWorkbook
Mnumb = 101
Range("A8").Select

For i = 1 To 850

sFileBase = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
"Budget packs - Capital expenditure - comments\Test\BFR"
& _
Mnumb
sFilename = sFileBase & " bud v2.1.xls"
Set Aworkbook = Workbooks.Open(Filename:=sFilename, UpdateLinks:=0)

If Not SheetExists("Sch 7A", Aworkbook) Then Exit For

Set Aworkbook2 = Workbooks.Add

Aworkbook2.SaveAs Filename:=sfgilebase & " bud v2.1-2.xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Aworkbook2.Activate
ActiveCell = Mnumb

Morg = Lbud.TextBox_org
Mto = Lbud.TextBox_to

On Error Resume Next

For Each Sht In Worksheets
Aworkbook.Sheets("Sch 7A").Range("A1:X250").Select
Selection.Copy
Aworkbook2.Select
Aworkbook2.Sheets.Add
ActiveSheet.Range("A1").Select
ActiveSheet.Paste
Next

On Error GoTo 0

Aworkbook.Close

Application.CutCopyMode = False

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





--

HTH

RP
(remove nothere from the email address if mailing direct)


"Ctech" <[email protected]> wrote in
message news:[email protected]...
>
> All the files in the specified folder have the same name except one
> number
>
>
> This part opend the files:
>
> ' start number of file name
>
> Mnumb = 101
>
> ' When the file doesn't exist
>
> On Error GoTo Errorhandler
>
>
> For i = 1 To 850
>
> SFilename = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
> "Budget packs - Capital expenditure - comments\Test\BFR" & Mnumb & "
> bud v2.1.xls"
>
> Application.Workbooks.Open Filename:=SFilename, UpdateLinks:=0
>
>
> --
> Ctech
> ------------------------------------------------------------------------
> Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
> View this thread: http://www.excelforum.com/showthread...hreadid=483865
>