H
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
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