try to concatenate data from multi-book to a single sheet

[jqzhang]

Hi,
I have about 20 work books and each has only one sheet in it. What I am planning to do is to bring in the data in the 20 sheets from the 20 books and concatenate (append) them in a single sheet.
Here is the code but not working. It looks like it copies only the first sheet and halted. The error says like 'the property or method not supported' (the last part of Copy and Paste).
I tried diff. ways but none of them worked.
Thanks in advance.
jqzhang

*******************
Function FileName(filespec) As String
Dim x As Variant
x = Split(filespec, Application.PathSeparator)
FileName = x(UBound(x))
End Function

Sub CopyBookSheets()
'On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim tabarray As Variant, y As Range
Dim oBook As Workbook, nBook As Workbook
tabarray = Array("c:\novstuff\cadi\CADI_ADVANCEPCS_0009045500_V.XLS", _
"c:\novstuff\cadi\CADI_AETNAHEALT_0009021344_V.XLS", _
"c:\novstuff\cadi\CADI_ANTHEMPRES_0009014750_F.XLS") 'I have 17 more; but this is for testing
For i = 0 To UBound(tabarray)
Set oBook = Workbooks.Open(tabarray(i))
bookname = FileName(tabarray(i))
sheetname = Mid(bookname, 1, InStr(bookname, ".") - 1)
' MsgBox sheetname
oBook.Sheets(sheetname).Activate
With ActiveSheet
.UsedRange.Copy
End With
Windows("TestBook1.xls").Activate
If i > 0 Then
Range("A1").Select
ActiveSheet.Paste
Else
lastrow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Worksheets("Sheet1").Range("A" & lastrow + 1).Select
With Selection
.Paste
End With
End If
oBook.Close SaveChanges:=False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
On Error GoTo 0
End Sub

 

[Gavona]

Try changing
If i > 0 Then
to
If i < 0 Then

If it still doesn't work I would enable screenupdating and step through the code.


Gavin

 

[Gavona]

Sorry, if i=0

Also
With Selection
.Paste
End With

should be
ActiveSheet.Paste



Gavin