本帖最后由 LWXT 于 2017-8-11 23:51 编辑
各位高手我在网上求得一合并文件夹下所有工作簿中第一个工作表的代码,非常好用。该代码合并后保留原工作表的公式、格式等,但是日常工作中有些表格保留公式,合并后出现错误。我是初学,求高手帮助修改下代码,使得合并后的工作表不包含原工作表的公式、格式。谢谢
代码如下: 详见附件
事例.zip
(138.3 KB, 下载次数: 4)
Sub合并() Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer Application.ScreenUpdating = False '冻结屏幕,以防屏幕抖动 myPath = ThisWorkbook.Path & "\" '把文件路径定义给变量
myFile = Dir(myPath & "*.xls") '依次找寻指定路径中的*.xls文件 DoWhile myFile <> "" '当指定路径中有文件时进行循环 If myFile <> ThisWorkbook.Name Then Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件 For i = 1 To AK.Sheets.Count aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row +1
'AK.Sheets(i).Select AK.Sheets(i).Range("a2:k" & aRow).CopyThisWorkbook.Sheets(1).Range("a" & tRow) Next Workbooks(myFile).Close False '关闭源工作簿,并不作修改 End If myFile = Dir '找寻下一个*.xls文件 Loop
Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用 MsgBox "汇总完成,请查看!", 64, "提示"
End Sub
|