'依次打开当前文件夹中所有的工作簿并且向该工作簿中的工作表中写入内容后并保存
Sub OpenAndSave()
Dim myPath$, myFile$, AK As Workbook
Dim sh As Worksheet
Dim i As Integer
i = 2
Dim fname As String
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
myPath = "C:\Users\DELL\Desktop\新建文件夹 (2)\" '把文件路径定义给变量
myFile = Dir(myPath & "*.xlsx") '依次找寻指定路径中的*.xlsx文件
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
Debug.Print AK.Name
Set sh = AK.Sheets(1)
With sh
.Range("A1").Value = "测试123"
End With
i = i + 1
AK.Save
AK.Close
Set AK = Nothing
End If
myFile = Dir '找寻下一个*.xlsx文件
Loop
Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
End Sub
你好，我是有问必答小助手，非常抱歉，本次您提出的有问必答问题，技术专家团超时未为您做出解答
本次提问扣除的有问必答次数，将会以问答VIP体验卡（1次有问必答机会、商城购买实体图书享受95折优惠）的形式为您补发到账户。
因为有问必答VIP体验卡有效期仅有1天，您在需要使用的时候【私信】联系我，我会为您补发。