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