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