EXCEL如何使用VBA汇总当前路径下的工作簿的相应的工作表?

来源:转载

一个论坛上的会员有如下的要求:如图需要把当前路径中的财务、采购、工厂、计划、人士等工作簿的“出勤明细”工作表的记录复制汇总在“加班汇总表”工作簿中的“加班原因汇总”工作表中,并需要取出各部门的名称,希望批量使用VBA完成?很久没有玩VBA了,今晚手痒,写了这样一个程序:

A:ALT+F11>>>插入模块>>>模块中输入以下代码:

EXCEL如何使用VBA汇总当前路径下的工作簿的相应的工作表?

 

Sub test()

Dim WB As Workbook, WS As Worksheet, FN$, Rng As Range, k As Long

Application.ScreenUpdating = False

FN = Dir(ThisWorkbook.Path & "\*.xls*")

Application.AutomationSecurity = msoAutomationSecurityForceDisable

Do While FN <> ""

If FN <> ThisWorkbook.Name Then

Set WB = GetObject(ThisWorkbook.Path & "" & FN)

With WB

For Each WS In .Worksheets

If WS.Name Like "*出勤明细*" Then

With WS

i = .Cells(Rows.Count, 2).End(xlUp).Row

.Range("A2:D" & i).Copy

Set Rng = ThisWorkbook.Worksheets("加班原因汇总").Cells(ThisWorkbook.Worksheets("加班原因汇总").Rows.Count, 2).End(xlUp).Offset(1, 0)

With Rng

.PasteSpecial xlPasteFormats

.PasteSpecial xlPasteAll

End With

ThisWorkbook.Worksheets("加班原因汇总").Cells(ThisWorkbook.Worksheets("加班原因汇总").Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(i - 1, 1) = Left(WB.Name, Len(WB.Name) - 4)

Application.CutCopyMode = False

End With

End If

Next WS

End With

WB.Close False

End If

FN = Dir

Loop

Application.AutomationSecurity = msoAutomationSecurityByUI

End Sub

 

分享给朋友:
您可能感兴趣的文章:
随机阅读: