Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
#7
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#8
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
VBA: Make a new sheet if it doesn't exist | Excel Discussion (Misc queries) | |||
VBA, Make a new sheet if it doesn't exist | Excel Discussion (Misc queries) | |||
Does the sheet exist? | Excel Programming | |||
test if a sheet exist (with the name) ? | Excel Programming | |||
Does sheet exist? | Excel Programming |