Problema al juntar archivos excel

Hola, buenos días y muchas gracias de antemano.
Mi problema es el siguiente, tengo en una carpeta una serie de archivos excel. Solo tienen ocupada la columna A. Y lo que quiero es juntarlos todos en una hoja y que en la columna B me aparezca de que hoja viene. Encontré una macro y la modifique un poco para que hiciese lo que yo quiero, pero por ahora solo me coge la primera fila de cada archivo, y yo necesito que me coja todas las filas de cada archivo. Esta es mi macro:
Sub CopySheet()
Dim basebook As Workbook
Dim mybook As Workbook
Dim i As Long
Application.ScreenUpdating = False ' Esto para que no muestre lo que hace la macro
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\libros excel" ' Aqui esta la carpeta donde estan los libros
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
For i = 2 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
  basebook.Sheets(1).Range("B" & i) = ActiveSheet.Parent.Name
  basebook.Sheets(1).Range("A" & i) = mybook.Worksheets(1).Range("A1")
mybook.Close
Next i
End If
End With
Application.ScreenUpdating = True
End Sub
He intentado cambiar los rangos de ("B" & i), pero me da error al utilizar variables que me cree y no se como puedo hacer para que me coja todas las filas de cada hoja excel.
Muchas gracias si alguien sabe como ayudarme!
Un saludo.