从多本工作簿复制单个工作表并粘贴在单个工作簿中
从多本工作簿复制单个工作表并粘贴在单个工作簿中
提问于 2022-08-09 10:34:25
我试图使用VBA来自动化一个枯燥的工作过程。我不懂这门语言，所以我从互联网上复制了一个代码，如下所示：
问题陈述:我在一个文件夹中有多个excel文件，我必须从它们中提取一个名为"sheet 1“的(所有文件都有它，但sheet1不是这些工作簿中仅有的一个工作表)。
然后我必须将它们粘贴到新的工作簿中。(我不介意它们是否都在不同的工作表中，因为稍后我只会记录一个宏来编译它们)**
有人有什么建议吗？
Sub Combine_files()
Dim Path As String
Dim Filename As String
Dim Sheet As Worksheet
Path = "C:\Users\prayag.purohit\OneDrive\Desktop\Project KC\New folder\"
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub回答 1
Stack Overflow用户
回答已采纳
发布于 2022-08-09 12:02:15
下面的代码将每个文件中的第一个工作表命名为文件名。
Option Explicit
Sub Combine_files()
Dim Path As String, Filename As String
Dim wbFile As Workbook, wbActive As Workbook
Set wbActive = ActiveWorkbook
Path = "C:\Users\prayag.purohit\OneDrive\Desktop\Project KC\New folder\"
Filename = Dir(Path & "*.xlsx")
With Application
.ScreenUpdating = False
End With
Do While Filename <> ""
Set wbFile = Workbooks.Open(Path & Filename, False, True)
wbFile.Sheets(1).Copy After:=wbActive.Sheets(1)
wbActive.Sheets(2).Name = Filename
wbFile.Close SaveChanges:=False
Filename = Dir()
Loop
wbActive.Sheets(1).Select
With Application
.ScreenUpdating = True
End With
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/73290373
复制相关文章
相似问题
腾讯云开发者
