|
Excel Looping code....
I previously posted and was able to get the code help I needed to open all workbooks in a specified folder....Now I've added some code to copy the worksheets to a new workbook...which it does fine, but it keeps looping... Basically, I can't get it to stop after it works thru the 5 open workbooks and copies the sheets i've specified to the new workbook. As w/ the original code, the wbks it copies from range from 4 - 20 daily...I've posted the original working code, and then the code w/ updated commands, that causing me grief... Dim x As Integer Dim WB As String Dim wbk As Workbook For x = 1 To 100 WB = "G:\ClaimsXten\TEST\RBA\RBA " & x & ".xls" On Error Resume Next Set wbk = Workbooks.Open(Filename:=WB) Worksheets("Current Rules - 1").Activate On Error GoTo 0 If Not wbk Is Nothing Then End If Next End Sub THIS WORKS GREAT...BELOW IS WHERE I'VE MESSED IT UP +_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_ +_+_+_+_+_ Dim x As Integer Dim WB As String Dim wbk As Workbook For x = 1 To 100 WB = "G:\ClaimsXten\TEST\RBA\RBA " & x & ".xls" On Error Resume Next Set wbk = Workbooks.Open(Filename:=WB) Worksheets("Current Rules - 1").Activate On Error GoTo 0 If Not wbk Is Nothing Then 'NEW CODING CAUSING LOOP Columns("A:BB").Select With Selection ..HorizontalAlignment = xlCenter ..VerticalAlignment = xlBottom ..WrapText = False ..Orientation = 0 ..AddIndent = False ..IndentLevel = 0 ..ShrinkToFit = False ..ReadingOrder = xlContext ..MergeCells = False End With Sheets("Current Rules - 1").Select Sheets("Current Rules - 1").Select Sheets("Current Rules - 1").Copy Befo=Workbooks("RBA Indi.xls").Sheets(1) Application.Run "PERSONAL.XLS!rbaHideandFilter" 'Code End End If Next End Sub -- have_a_cup ------------------------------------------------------------------------ have_a_cup's Profile: http://www.excelforum.com/member.php...o&userid=35394 View this thread: http://www.excelforum.com/showthread...hreadid=552945 |
Excel Looping code....
Dim x As Integer Dim WB As String Dim wbk As Workbook For x = 1 To 100 WB = "G:\ClaimsXten\TEST\RBA\RBA " & x & ".xls" On Error Resume Next Set wbk = Nothing Set wbk = Workbooks.Open(Filename:=WB) if wbk is nothing then exit sub Worksheets("Current Rules - 1").Activate On Error GoTo 0 With Columns("A:BB") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("Current Rules - 1").Select Sheets("Current Rules - 1").Copy _ Befo=Workbooks("RBAIndi.xls").Sheets(1) Application.Run "PERSONAL.XLS!rbaHideandFilter" wbk.Close SaveChanges:=False Next -- Regards, Tom Ogilvy "have_a_cup" wrote in message ... I previously posted and was able to get the code help I needed to open all workbooks in a specified folder....Now I've added some code to copy the worksheets to a new workbook...which it does fine, but it keeps looping... Basically, I can't get it to stop after it works thru the 5 open workbooks and copies the sheets i've specified to the new workbook. As w/ the original code, the wbks it copies from range from 4 - 20 daily...I've posted the original working code, and then the code w/ updated commands, that causing me grief... Dim x As Integer Dim WB As String Dim wbk As Workbook For x = 1 To 100 WB = "G:\ClaimsXten\TEST\RBA\RBA " & x & ".xls" On Error Resume Next Set wbk = Workbooks.Open(Filename:=WB) Worksheets("Current Rules - 1").Activate On Error GoTo 0 If Not wbk Is Nothing Then End If Next End Sub THIS WORKS GREAT...BELOW IS WHERE I'VE MESSED IT UP +_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_+_ +_+_+_+_+_ Dim x As Integer Dim WB As String Dim wbk As Workbook For x = 1 To 100 WB = "G:\ClaimsXten\TEST\RBA\RBA " & x & ".xls" On Error Resume Next Set wbk = Workbooks.Open(Filename:=WB) Worksheets("Current Rules - 1").Activate On Error GoTo 0 If Not wbk Is Nothing Then 'NEW CODING CAUSING LOOP Columns("A:BB").Select With Selection HorizontalAlignment = xlCenter VerticalAlignment = xlBottom WrapText = False Orientation = 0 AddIndent = False IndentLevel = 0 ShrinkToFit = False ReadingOrder = xlContext MergeCells = False End With Sheets("Current Rules - 1").Select Sheets("Current Rules - 1").Select Sheets("Current Rules - 1").Copy Befo=Workbooks("RBA Indi.xls").Sheets(1) Application.Run "PERSONAL.XLS!rbaHideandFilter" 'Code End End If Next End Sub -- have_a_cup ------------------------------------------------------------------------ have_a_cup's Profile: http://www.excelforum.com/member.php...o&userid=35394 View this thread: http://www.excelforum.com/showthread...hreadid=552945 |
| All times are GMT +1. The time now is 03:21 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com