如何跨多个工作簿文件同时运行宏？

本文，我将讨论如何在不打开文件的情况下同时在多个工作簿文件中运行宏。以下方法可以帮助您解决Excel中的此任务。

使用VBA代码在多个工作簿中同时运行宏

若要跨多个工作簿运行宏而不打开它们，请应用以下VBA代码：

1。按住 ALT + F11 键打开 Microsoft Visual Basic应用程序 窗口。

2。点击插页 > 模块，然后将以下宏粘贴到模块窗口。

VBA代码：在多个工作簿上同时运行相同的宏：

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

备注：在以上代码中，请复制并粘贴您自己的代码，但不要小组标题和 END SUB 之间的页脚 与Workbooks.Open（xFdItem和xFileName） 和结束脚本。看截图：

doc运行宏多个文件1

3。然后按 F5 执行此代码的密钥，以及一个浏览显示窗口，请选择一个文件夹，其中包含您要全部应用此宏的工作簿，请参见屏幕截图：

doc运行宏多个文件2

4. 然后点击 OK 按钮，将立即从一个工作簿到另一个工作簿执行所需的宏。

最佳办公效率工具

Kutools for Excel解决了您的大多数问题，并使您的生产率提高了80％

重用: 快速插入 复杂的公式，图表 以及您以前使用过的任何东西；加密单元带密码创建邮件列表并发送电子邮件...
超级公式栏（轻松编辑多行文本和公式）；阅读版式（轻松读取和编辑大量单元格）；粘贴到过滤范围...
合并单元格/行/列不会丢失数据；拆分单元格内容；合并重复的行/列...防止细胞重复；比较范围...
选择重复或唯一行; 选择空白行（所有单元格都是空的）；超级查找和模糊查找在许多工作簿中；随机选择...
确切的副本多个单元格，无需更改公式参考；自动创建参考到多张纸；插入项目符号，复选框等...
提取文字，添加文本，按位置删除，删除空间; 创建和打印分页小计；在单元格内容和注释之间转换...
超级滤镜（将过滤方案保存并应用于其他工作表）；高级排序按月/周/日，频率及更多；特殊过滤器用粗体，斜体...
结合工作簿和工作表; 根据关键列合并表；将数据分割成多个工作表; 批量转换xls，xlsx和PDF...
超过300种强大功能. 支持 Office / Excel 2007-2021 和 365。支持所有语言。在您的企业或组织中轻松部署。完整功能 30 天免费试用。 60 天退款保证。

阅读更多免费下载... 采购...

Office选项卡为Office带来了选项卡式界面，使您的工作更加轻松

在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。
在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
每天将您的工作效率提高50％，并减少数百次鼠标单击！

阅读更多免费下载... 采购...

注释 (43)

4.5中的5评分 · 1评级

尤利亚·柯特曼

大约4年前

#27193

该评论由网站上的主持人最小化

非常有用的宏，它工作正常，但我希望能够从该文件夹中选择我希望运行宏的文件？这些文件不会在单独的文件夹中自动生成，我需要对该文件夹中的每组文件运行不同的宏，然后将它们移回初始文件夹中。

报告

亚通物流

大约3年前

#28785

该评论由网站上的主持人最小化

我按照说明进行操作，但出现编译错误“Loop whtout Do”。我错过了什么？我的宏代码非常简单，只需更改指定行的字体大小。它自己工作。这是我所拥有的...请帮助

子循环文件（）
将 xFd 调暗为 FileDialog
将 xFdItem 调暗为变体
将 xFileName 调暗为字符串
设置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那么
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
当 xFileName <> ""
与Workbooks.Open（xFdItem和xFileName）
'你的代码在这里
行（“2：8”）。选择
使用 Selection.Font
.Name = "宋体"
.大小 = 12
.删除线=假
.上标=假
.下标=假
.OutlineFont = 假
.Shadow = 假
.Underline = xlUnderlineStyleNone
.颜色 = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
结束
xFileName = 目录
循环
结束如果
END SUB

报告

天阳亚通物流

大约3年前

#28786

该评论由网站上的主持人最小化

你好，亚托，
您错过了代码末尾的“End with”脚本，正确的应该是：
子循环文件（）
将 xFd 调暗为 FileDialog
将 xFdItem 调暗为变体
将 xFileName 调暗为字符串
设置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那么
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
当 xFileName <> ""
与Workbooks.Open（xFdItem和xFileName）
'你的代码在这里
行（“2：8”）。选择
使用 Selection.Font
.Name = "宋体"
.大小 = 16
.删除线=假
.上标=假
.下标=假
.OutlineFont = 假
.Shadow = 假
.Underline = xlUnderlineStyleNone
.颜色 = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
结束
结束
xFileName = 目录
循环
结束如果
END SUB

请尝试一下，希望对您有所帮助！

报告

乔尔

大约3年前

#28789

该评论由网站上的主持人最小化

非常有用的宏，而且效果很好，但是我希望能够从该文件夹中选择要运行宏的文件？例如，我在一个文件夹中有 4 个文件和其他 excel 文件，我只希望它在这 4 个特定文件上运行。如何调整您的宏以让我从该文件夹中选择这 4 个文件？

天阳乔尔

大约3年前

#28790

该评论由网站上的主持人最小化

嗨，乔尔，
要在特定工作簿中触发相同的代码，您应该应用以下代码：

子循环文件（）
将 xFd 调暗为 FileDialog
将 xFdItem 调暗为变体
将 xFileName 调暗为字符串
将 xFB 调暗为字符串
使用 Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = 真
.Filters.Clear
.Filters.添加“excel”、“*.xls*”
。展示
如果 .SelectedItems.Count < 1 则退出 Sub
对于 lngCount = 1 到 .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
如果 xFileName <> "" 那么
使用 Workbooks.Open（文件名：=xFileName）
'你的代码
结束
结束如果
下一个 lngCount
结束
END SUB

请尝试一下，希望对您有所帮助！

报告

Belema 天阳

大约3年前

#28791

该评论由网站上的主持人最小化

谢谢，真的很有帮助

隆天阳

大约3年前

#28792

该评论由网站上的主持人最小化

嗨！

我尝试将我的代码插入到您的代码中，当我运行宏时，它给了我以下消息：运行时错误“429”：ActiveX 无法创建对象。请告知如何修复它。谢谢！

我的代码：

设置 RInput = Range("A2:A21")
设置 ROutput = Range("D2:D22")

将 A() 调暗为变体
ReDim A(1 到 RInput.Rows.Count, 0)
A = RInput.Value2

设置 d = CreateObject("Scripsting.Dictionary")

对于 i = 1 到 UBound(A)
如果 d.Exists(A(i, 1)) 那么
d(A(i, 1)) = d(A(i, 1)) + 1
其他
d.添加 A(i, 1), 1
结束如果
下一页
对于 i = 1 到 UBound(A)
A(i, 1) = d(A(i, 1))
下一页

R输出 = A

报告

凯特琳贾维斯

大约3年前

#30056

该评论由网站上的主持人最小化

嗨，首先感谢您提供这个宏，这正是我想要的。但是我确实有一个问题，有没有办法在每个窗口完成时关闭并保存它。我有大量文件，并且在执行完成之前内存不足。

报告

曼维尔·赖凯特琳贾维斯

大约3年前

#30057

该评论由网站上的主持人最小化

是的，如果您希望它以相同的名称保存文件，只需在下面添加以下代码：

'保存工作簿
ActiveWorkbook.保存

天阳凯特琳贾维斯

大约3年前

#30058

该评论由网站上的主持人最小化

你好，凯特琳，
也许下面的代码可以帮助您，每次运行您的特定代码后，都会弹出一个保存文件提示框，提醒您保存工作簿。

子循环文件（）
将 xFd 调暗为 FileDialog
将 xFdItem 调暗为变体
将 xFileName 调暗为字符串
将 xWB 调暗为工作簿
设置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那么
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
出错时继续下一步
当 xFileName <> ""
设置 xWB = Workbooks.Open(xFdItem & xFileName)
带 xWB
'你的代码在这里
结束
xWB.关闭
xFileName = 目录
循环
结束如果
END SUB

报告

隆

大约3年前

#31246

该评论由网站上的主持人最小化

报告

跳过博罗维茨

大约3年前

#31800

该评论由网站上的主持人最小化

你好，

我已经成功地使用这个宏为 30 支球队格式化了 NBA 文件，每支球队都有自己的书。昨天，我收到一条错误消息，指出模块（宏）无法完成或删除或编辑（要保存）。它损坏了我的个人宏工作簿，使 Excel 对我几乎无法使用。每次我尝试从任何文件访问宏时，它都会使应用程序崩溃。 Excel 支持和 Windows 支持无法解决问题。你能帮我吗？

迪帕克

大约3年前

#31969

该评论由网站上的主持人最小化

嗨，有没有办法可以在脚本本身中定义文件目标。我想跳过我们必须浏览特定文件夹的过程 3。

阿萨兰

大约2年前

#32274

该评论由网站上的主持人最小化

嗨，谢谢你的代码。你能告诉我如何获得我在一张表中打开所有工作簿的宏的结果（连续每个工作簿的结果）？有没有办法将每个工作簿的名称添加到包含上一步数据的行中？

阿尔茨海默氏症

大约2年前

#32668

该评论由网站上的主持人最小化

Hi

我收到 aa 1004 运行时错误：当我运行以下代码时，语法不正确，该代码是扩展 Office VBA 以“使用 VBA 代码在多个工作簿中同时运行宏”和扩展 Office VBA“删除所有命名范围”使用 VBA 代码”插入您的代码槽：

子循环文件（）

将 xFd 调暗为 FileDialog

将 xFdItem 调暗为变体

将 xFileName 调暗为字符串

设置 xFd = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFd.Show = -1 那么

xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

xFileName = Dir(xFdItem & "*.xls*")

当 xFileName <> ""

与Workbooks.Open（xFdItem和xFileName）

' 子删除名称（）

'更新 20140314

将 xName 调暗为名称

对于 Application.ActiveWorkbook.Names 中的每个 xName

xName.删除

下一页

结束

xFileName = 目录

循环

结束如果

END SUB

我想要做的是运行一个宏来删除同一文件夹中包含的八个工作簿中的命名范围。

顺便说一句，这是我第一次使用 Extend Office 的东西，但它没有用。这个网站对我非常有帮助。

建议/意见将不胜感激。

阿尔茨海默氏症

报告

天阳阿尔茨海默氏症

大约2年前

#32669

该评论由网站上的主持人最小化

你好，aldc，
您的代码在我的工作簿中运行良好，您使用哪个 Excel 版本？

报告

奥斯卡·费恩霍尔姆

大约2年前

#33194

该评论由网站上的主持人最小化

您好，这段代码非常好用。我经常使用它！

如今，在我的组织中，我们现在使用 SharePoint 来存储我们的文件。有什么方法可以使此代码在共享点文件夹中的所有文件中工作？

达尔科

大约2年前

#34033

该评论由网站上的主持人最小化

您好，感谢您提供此代码。
有没有办法循环遍历子文件夹？假设我有一个文件夹，并且在文件夹中还有十个文件夹，每个文件夹都包含一个 excel 文件。

有没有办法只选择主文件夹，以便代码在其所有子文件夹中运行？

感谢。

天阳达尔科

大约2年前

#34034

该评论由网站上的主持人最小化

嗨，Darko，要从包含子文件夹的文件夹中运行代码，请应用以下代码：子 LoopThroughFiles_Subfolders（xStrPath 作为字符串）
暗淡 xSFolderName
暗淡 xFileName
将 xArrSFPath() 调暗为字符串
将 xI 调暗为整数
如果 xStrPath = "" 则退出 Sub
xFileName = Dir(xStrPath & "*.xls*")
当 xFileName <> ""
使用 Workbooks.Open(xStrPath & xFileName)
'你的代码在这里
结束
xFileName = 目录
循环
xSFolderName = 目录（xStrPath，vbDirectory）
xI = 0
重新调整 xArrSFPath(0)
Do While xSFolderName <> ""
如果 xSFolderName <> "." 和 xSFolderName <> ".." 然后
If (GetAttr(xStrPath & xSFolderName) And vbDirectory) = vbDirectory Then
xI = xI + 1
ReDim 保留 xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
结束如果
结束如果
xSFolderName = 目录
循环
如果 UBound(xArrSFPath) > 0 那么
对于 xI = 0 到 UBound(xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
下一个
结束如果
END SUB
子循环文件（）
将 xFd 调暗为 FileDialog
将 xFdItem 调暗为变体
将 xFileName 调暗为字符串
设置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那么
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
结束如果
完子请试一试，希望能帮到你！

报告

萨尔

大约2年前

#34552

该评论由网站上的主持人最小化

除了上面的代码，是否可以按我想要的时间顺序打开 excel 文件？

苏里亚

大约2年前

#34613

该评论由网站上的主持人最小化

大家好，首先感谢宏，它使用起来非常方便。我只是想知道我们是否有办法通过宏刷新 onedrive 中的文件夹。如果是的话，你能告诉我我可以在这里做什么来使用宏脚本刷新onedrive中的文件吗？

报告

草坪草

大约 1 年前

#34866

该评论由网站上的主持人最小化

嗨，非常感谢这个脚本，我工作得很好，但我有特殊需要：有没有办法更改脚本以将我的代码应用到文件名条件和子文件夹中？
我解释说：我是一名教师，我创建了一个 Excel 解决方案来保存学生的成绩并允许教师查阅他们。为此，我为每个学校的 subjet 和一个负责班级的文件都有一个文件，所有这些文件都在每个班级的一个文件夹中。
因此，当我发现错误或优化时，我必须报告所有子文件夹中所有文件的更改。
但是由于所有文件都不相同（不同的 subjets 组织），我想要一种方法将我的代码示例应用于所有子文件夹中名为“数学类”的所有文件，或者相反，将我的代码应用于所有文件在所有名为“xyz”的文件之外的子文件夹中。谢谢！Fabrice

报告

穆罕默德·纳维德

大约 1 年前

#35118

该评论由网站上的主持人最小化

您给定的代码不适用于以下 VBA 可以请帮助Sub Bundles()

将 vWS 调暗为工作表
暗淡 vA, vA2()
将 vR 变暗、vSum 变暗、vC 变暗
将 vN 变暗、vN2 变暗、vN3 变暗

设置 vWS = ActiveSheet
使用 vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim 保留 vA2（1 到 vSum，1 到 4）
vA = .Range("A2:D" & vR)
对于 vN = 1 到 vR - 1
对于 vN2 = 1 至 vA(vN, 4)
vC = vC + 1
对于 vN3 = 1 至 4
vA2(vC, vN3) = vA(vN, vN3)
下一个 vN3
下一个 vN2
下一个 vN
结束
vC = 1
对于 vN = 1 到 vSum - 2
vA2(vN, 4) = vC
如果 vA2(vN + 1, 2) = vA2(vN, 2) 那么
vC = vC + 1
vA2(vN + 1, 4) = vC
其他
vA2(vN + 1, 4) = 1
vC = 1
结束如果
下一个 vN
Application.ScreenUpdating = False
表格。添加
使用ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
结束
Application.ScreenUpdating =真

END SUB

米纳维德

大约 1 年前

#35119

该评论由网站上的主持人最小化

我想一次将这个 VBA 运行到一个文件夹中的多个工作表中，你可以帮助Sub Bundles()

将 vWS 调暗为工作表
暗淡 vA, vA2()
将 vR 变暗、vSum 变暗、vC 变暗
将 vN 变暗、vN2 变暗、vN3 变暗

设置 vWS = ActiveSheet
使用 vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim 保留 vA2（1 到 vSum，1 到 4）
vA = .Range("A2:D" & vR)
对于 vN = 1 到 vR - 1
对于 vN2 = 1 至 vA(vN, 4)
vC = vC + 1
对于 vN3 = 1 至 4
vA2(vC, vN3) = vA(vN, vN3)
下一个 vN3
下一个 vN2
下一个 vN
结束
vC = 1
对于 vN = 1 到 vSum - 2
vA2(vN, 4) = vC
如果 vA2(vN + 1, 2) = vA2(vN, 2) 那么
vC = vC + 1
vA2(vN + 1, 4) = vC
其他
vA2(vN + 1, 4) = 1
vC = 1
结束如果
下一个 vN
Application.ScreenUpdating = False
表格。添加
使用ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
结束
Application.ScreenUpdating =真

END SUB

报告

卢迪文 S。

大约 1 年前

#35518

该评论由网站上的主持人最小化

我尝试运行代码，但错误“424：Object Required”出现在“With Workbooks.Open(xFdItem & xFileName)”行。通过深入研究，似乎存储在感兴趣的文件夹中的 excels 工作簿不显示/不存在（当窗口打开并显示代码时，如果我尝试打开文件夹而不选择它，它是空的）。怎么会这样？
子循环文件（）
将 xFd 调暗为 FileDialog
将 xFdItem 调暗为变体
将 xFileName 调暗为字符串
设置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那么
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
当 xFileName <> ""
与Workbooks.Open（xFdItem和xFileName）
Sheets.Add After：=ActiveSheet
表格（“Sheet2”）。选择
Sheets("Sheet2").Name = "Master"
表（“主”）。选择
Sheets("Master").Move Before:=Sheets(1)
结束
xFileName = 目录
循环
结束如果
END SUB

你能帮我解决这个问题吗？

客人

大约 1 年前

#36438

该评论由网站上的主持人最小化

这是我最喜欢的网站，它有最清晰的说明（比任何 YouTube 视频都多），我会一次又一次地回到它。非常感谢你提供这些教程——你是一个悲伤的研究生的救命稻草。

贫穷

大约 1 年前

#36463

该评论由网站上的主持人最小化

子循环文件（）
将 xFd 调暗为 FileDialog
将 xFdItem 调暗为变体
将 xFileName 调暗为字符串
设置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那么
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
当 xFileName <> ""
与Workbooks.Open（xFdItem和xFileName）
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
选择.插入 Shift:=xlToRight
ActiveCell.选择
结束
xFileName = 目录
循环
结束如果
结束子，请帮助。顺便说一句，我的 excel 文件扩展名是 (.csv - "comma delimited") 。我在一个文件夹中有 500 个 excel 文件，每行平均大约有 500000 行。请帮忙。我只想在每个工作簿中插入列

卡莉·本杰明（Carly Benjamin）贫穷

大约 1 年前

#36464

该评论由网站上的主持人最小化

你有没有得到你的问题的答案？我正在尝试对 3700 多个 csv 文件做同样的事情。我只需要添加 1 列 (A)。

天阳卡莉·本杰明（Carly Benjamin）

大约 1 年前

#36465

该评论由网站上的主持人最小化

嗨，有需要的 Carly，为了解决您的问题，要运行多个 CSV 文件的代码，您只需将 .xls 文件扩展名更改为 .csv，如下所示：子循环文件（）
将 xFd 调暗为 FileDialog
将 xFdItem 调暗为变体
将 xFileName 调暗为字符串
设置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那么
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
当 xFileName <> ""
与Workbooks.Open（xFdItem和xFileName）
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
选择.插入 Shift:=xlToRight
ActiveCell.选择
结束
xFileName = 目录
循环
结束如果
完子请试一试，希望能帮到你！

报告