Excel高效办公——财务工作常用VBA代码分享

    4、批量修改指定文件夹下各文件工作表内容

    5、提取指定文件夹下的子文件夹名称

Sub T1()

h = 3         ‘放入目标文件第3行，可根据实际需要修改

Mypath = ThisWorkbook.Path      ‘需根据实际文件夹路径进行修改

Myfile = Dir(Mypath & “\*”)

Do While Myfile <> “”

Cells(h, 2) = Myfile

h = h + 1

Myfile = Dir

Loop

End Sub

Sub T2()

Mypath = ThisWorkbook.Path‘需根据实际文件夹路径进行修改

For i = 3 To cells(rows.count.end(xlup).row,”A”) 

‘A列第3行至最后1行，需根据实际修改

Yname = Mypath & Cells(i, 2)     ‘原文件名称

Xname = Mypath & Cells(i, 3)     

‘新文件名称，名称后需带有扩展名（如 .xlxs)

Name Yname As Xname

Next

End Sub

Sub T3()

h = 3

Myfile = Dir(ThisWorkbook.Path & “\*”)

‘需根据实际文件夹路径进行修改

Do While Myfile <> “”

Temp = ThisWorkbook.Path & “\” & Myfile

Set Wb = GetObject(Temp)

Cells(h, 4) = Myfile & “-” & Wb.Sheets(1).Range(“A41”)

’提取指定文件夹下所有Excel文件的第1个工作表A41单元格内容

‘提取数据写入目标工作表第4列，从第3行开始

‘拟提取的单元格及拟写入的单元格，可根据实际需要修改

Wb.Close savechanges = False

Set Wb = Nothing

h = h + 1

Myfile = Dir

Loop

End Sub

4、批量修改指定文件夹下各文件工作表内容

Sub T4()

Mypath = ThisWorkbook.Path & “\“

Myname = Dir(Mypath & “*”)

Do While Myname <> “”

With Workbooks.Open(Mypath & Myname)

.Sheets(1).Range(“A2”) = “截止日期：2025-12-31“

‘将指定文件夹下所有Excel文件第1个工作表A2单元格内容修改为“截止日期：2025-12-31“，可根据实际需要修改。

.Close True

End With

Myname = Dir

Loop

End Sub

 5、提取指定文件夹下的子文件夹名称

Sub T5()

Dim fs As Object

n = 1

Set fs = CreateObject(“Scripting.FileSystemObject”)

Set f = fs.getfolder(“C:\Users\Desktop\指定文件夹名称“)

For Each fd In f.subfolders

Cells(n, 1) = fd.Name

n = n + 1

Next

Set f = Nothing

Set fs = Nothing

End Sub

Sub T6()

Dim a As Worksheet

For Each a In Worksheets

a.Protect AllowFiltering:=True

a.Unprotect

Next

End Sub