VBA代码更改为所有工作表

zjgldy

请老师赐教，下面代码要如何把指定工作表改为所有工作表，谢谢指教！
Sub 填充()

t = Timer
    a= Dir(ThisWorkbook.Path & "\*.xls")
Do Until a = ""
   If a <> "替换内容.xlsm" Then
    n= n + 1
   Set sh = Workbooks.Open(ThisWorkbook.Path & "\" & a)
       With sh.Sheets("第 1 页")
            rs = .[c65536].End(3).Row
                .Range("b6") =Mid(.Range("b6"), 1, InStr(.Range("b6"), "：")) & "***有限公司"'ThisWorkbook.Sheets("名称").Range("b1")
                .Range("c" & rs)= Mid(.Range("c" & rs), 1, InStr(.Range("c" & rs),"：")) & "6789@qq.com"'ThisWorkbook.Sheets("名称").Range("b2")
           ActiveWorkbook.Close True
       End With
   End If
a = Dir
Loop
MsgBox "共计填充："& n & "个表格" & Chr(13) &"共计用时：" & Format(Timer - t,"0.0000") & "秒！", vbYesNo +vbInformation, "提示！"
End Sub

weare2

这个

zjgldy

weare2 发表于 2019-5-1 13:06
这个

非常谢谢您的帮助，完美解决问题。

weare2

zjgldy 发表于 2019-5-1 18:22
非常谢谢您的帮助，完美解决问题。

但是 也得要 10多秒呀！

zjgldy

weare2 发表于 2019-5-2 07:50
但是 也得要 10多秒呀！

您好，只要能实现时间长点没关系，谢谢您！

weare2

zjgldy 发表于 2019-5-2 12:04
您好，只要能实现时间长点没关系，谢谢您！

呵呵，不好意思，说错了！

lidayu

论坛高手如云，看到你求助实现了，我也学习了。