如何使用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

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

相关的链接：

Excel VBA - 遍历某个文件夹中文件、文件夹及批量建立txt
http://blog.csdn.net/alexbnlee/article/details/6932339

VBA如何获取当前EXCEL文件的路径
http://blog.sina.com.cn/s/blog_611f50100100w5x7.html