Excel Looping code....

[have_a_cup]

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 Before:=Workbooks("RBA
Indi.xls").Sheets(1)
Application.Run "PERSONAL.XLS!rbaHideandFilter"
'Code End

End If
Next




End Sub

 

[Don Guillett]

a VERY cursory look suggests

For x = 1 To 100
For x = 1 To workbooks.count

 

[Tom Ogilvy]

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 _
Before:=Workbooks("RBAIndi.xls").Sheets(1)
Application.Run "PERSONAL.XLS!rbaHideandFilter"
wbk.Close SaveChanges:=False
Next