My macro opens all workbooks in a specified folder and copies a rang
from a certain sheet. However I have now a problem as not all of th
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("Sc
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 Su

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

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" wrote in
message ...

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

How do I implement this function in my macro

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

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" wrote in
message ...

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

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

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("Sc
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 Functio

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

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" wrote in message
...

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

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

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


How can I do this

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

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

--

HTH

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


"Ctech" wrote in
message ...

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

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

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" wrote in
message ...

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