最近做了一个小的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