Thanks for the help, Dave. Sorry for the confusion...I think I had left a
line out and had another one that I didn't need. Here is the final code and
it works great.

Sub RegionList()
Dim FileList() As String
Dim Counter As Long
Dim NextFile As String
Dim thisfile As String
Dim DirToSearch As String
DirToSearch = "C:\Documents and Settings\User1\My Documents\CBAs"
Counter = 0
NextFile = Dir(DirToSearch & "\" & "*.xls")
Do Until NextFile = ""
ReDim Preserve FileList(Counter)
FileList(Counter) = DirToSearch & "\" & NextFile
Counter = Counter + 1
NextFile = Dir()
Loop
Application.Calculation = xlManual
On Error Resume Next
For Counter = LBound(FileList) To UBound(FileList)
Workbooks.Open Filename:=FileList(Counter)
thisfile = ActiveWorkbook.Name
'Paste Name
Windows(thisfile).Activate
Sheets("IO").Select
Range("A1").Select
Selection.Copy
Windows("NewBook.xls").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

'Paste Investment Values
Windows(thisfile).Activate
Sheets("CBA Template").Select
Range("B2:E2").Select
Selection.Copy
Windows("NewBook.xls").Activate
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Workbooks(thisfile).Saved = True
Workbooks(thisfile).Close
Next
Application.Calculation = xlAutomatic
End Sub

Steve Mackay


"Dave Peterson" wrote in message
...
I was kind of confused, but maybe this'll give you some ideas. It uses a
nice
function from Chip Pearson to check to see if a worksheet exists.