如何使用VBA实现将多个Excel文件中的数据复制到某个Excel文件中

最近做了一个小的Demo，实现了将各个销售的Excel台帐数据自动复制到主管的台帐Excel中，主要代码如下：

-------------------------------------------------------------

Sub CopyFromSubFiles()
Dim MyFile As String
Dim Arr(1000) As String '最多处理1000个子台帐
Dim count As Integer
Dim CurrentPath As String
Dim MyWorkbook As Workbook '父台帐
Dim Targetkbook As Workbook '子台帐
Dim StartLine1 As Integer
Dim StartLine2 As Integer

CurrentPath = ThisWorkbook.Path & '\temp\'

MyFile = Dir(CurrentPath & '*.*')
count = count + 1
Arr(count) = MyFile

Do While MyFile <> ''
MyFile = Dir
If MyFile = '' Then
Exit Do
End If
count = count + 1
Arr(count) = MyFile '将文件的名字存在数组中
Loop

'没有子台帐
If count <= 0 Then
Exit Sub
End If

'在父台帐中新建一个工作表
Worksheets.Add After:=Worksheets(Worksheets.count)

Sheets(1).Select
Sheets(1).Rows('1:2').Select
Selection.Copy

Sheets(Worksheets.count).Select
Sheets(Worksheets.count).Rows('1:1').Select

'Application.CutCopyMode = False '关闭剪贴板提示信息
ActiveSheet.Paste

Dim n As Integer
n = BaseLine

StartLine1 = n '父台帐开始复制的起始行

'打开每个子台帐，将信息复制到父台帐
For i = 1 To count

Workbooks.Open Filename:=CurrentPath & Arr(i) '循环打开Excel文件

Sheets(1).Select

n = BaseLine
'从第三行开始寻找子台帐信息的结束行
With Sheets(1)
Do While .Cells(n, 1).Text <> ''
n = n + 1
Loop
End With

StartLine2 = n - 1 '子台帐复制的结束行

'从起始行开始复制
Sheets(1).Rows(BaseLine & ':' & StartLine2).Select
Selection.Copy

ThisWorkbook.Activate
Sheets(Worksheets.count).Select
Sheets(Worksheets.count).Rows(StartLine1 & ':' & StartLine1).Select
ActiveSheet.Paste

StartLine1 = StartLine1 + StartLine2 - BaseLine '父台帐复制起始行向下移

Application.CutCopyMode = False '关闭剪贴板提示信息

Workbooks(Arr(i)).Close savechanges = False '关闭子台帐

Next

'ActiveWorkbook.Close savechanges = False '关闭打开的文件

ThisWorkbook.Activate
Sheets(Worksheets.count).Select
ActiveSheet.Range('A:AA').EntireColumn.AutoFit
ActiveSheet.Range('A1').Select
'Cells.EntireColumn.AutoFit

Application.CutCopyMode = True
End Sub

----------------------------------------------------------------