vba VBA从文件夹中的所有文件复制工作表并将其复制到母版
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/44423207/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA to copy sheets from all files in folder and copy it to master
提问by GT0028
I have a folder full of multiple excel files and all of the files have a specific sheet that i need to copy into my master.
我有一个文件夹，里面有多个 excel 文件，所有文件都有一个特定的工作表，我需要将其复制到我的母版中。
I need macro to open all files in that folder one by one and copy the specific sheet to the master file using the source file name as sheet name in the master workbook. Excel 2013.
我需要宏来一一打开该文件夹中的所有文件，并使用源文件名作为主工作簿中的工作表名称将特定工作表复制到主文件中。卓越 2013。
I tried searching online and have the following code:
我尝试在线搜索并获得以下代码：
Option Explicit
Sub test()
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim MyPath As String
Dim MyFile As String
Application.ScreenUpdating = False
Set wkbDest = ThisWorkbook
Set wksDest = wkbDest.Worksheets("Sheet1") 'change the destination sheet name accordingly
MyPath = "H:\Cutover\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xls")
Do While Len(MyFile) > 0
Set wkbSource = Workbooks.Open(MyPath & MyFile)
Set wksSource = wkbSource.Worksheets("Sheet1") 'change the source sheet name accordingly
'Your copy/paste code here (((((need help here please))))))))
wkbSource.Close savechanges:=False
MyFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Completed...", vbInformation
End Sub
EDIT:
编辑：
So i manage to get to the below however its still not working properly. It doesn't rename the sheet to the source filename. Can someone please help?
所以我设法到达下面但是它仍然无法正常工作。它不会将工作表重命名为源文件名。有人可以帮忙吗？
Option Explicit
选项显式
Sub test()
子测试()
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim MyPath As String
Dim MyFile As String
Application.ScreenUpdating = False
Set wkbDest = ThisWorkbook
Set wksDest = wkbDest.Worksheets("Sheet1") 'change the destination sheet name accordingly
MyPath = "H:\Cutover\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xlsx")
Do While Len(MyFile) > 0
Set wkbSource = Workbooks.Open(MyPath & MyFile)
Set wksSource = wkbSource.Worksheets("Sheet1") 'change the source sheet name accordingly
Sheets("SheetToCopy").Copy Before:=Workbooks("WorkbookToPasteIn").Sheets(SheetIndex)
wkbSource.Close savechanges:=False
MyFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Completed...", vbInformation
End Sub
结束子
回答by GT0028
so the part you need help with is how to copy/paste a range from a worksheet in one file to a common worksheet in a destination file?
所以您需要帮助的部分是如何将范围从一个文件中的工作表复制/粘贴到目标文件中的通用工作表？
set up a variable to track the last empty row in the destination sheet
设置一个变量来跟踪目标工作表中的最后一个空行
look up how to determine what the last row is in each source sheet, select that source range, copy it into the clipboard, and then paste it at the last empty row in the destination sheet, and reset the destination variable to the new first blank row in the destination sheet
查找如何确定每个源工作表中的最后一行是什么，选择该源范围，将其复制到剪贴板，然后将其粘贴到目标工作表中的最后一个空行，并将目标变量重置为新的第一个空白目标工作表中的行
an alternative way of doing it would be to open an output CSV file, and parse each row and build up a string and write it to the file without closing the output CSV file until the loop is over
另一种方法是打开一个输出 CSV 文件，然后解析每一行并建立一个字符串并将其写入文件而不关闭输出 CSV 文件，直到循环结束
if the files are large tho, it would be much better to use VB.NET instead as it is much faster at dealing with large files
如果文件很大，那么使用 VB.NET 会更好，因为它处理大文件要快得多
you could also read each file/row into an in-memory datatable and then output the datatable to a CSV file, or to the destination Excel file
您还可以将每个文件/行读入内存数据表，然后将数据表输出到 CSV 文件或目标 Excel 文件
which method would you prefer?
你更喜欢哪种方法？
回答by dominic111
You could simply copy your sheet in the new workbook, following this code:
您可以按照以下代码简单地在新工作簿中复制您的工作表：
Sheets("SheetToCopy").Copy Before:=Workbooks("WorkbookToPasteIn").Sheets(SheetIndex)
Sheets("SheetToCopy").Copy Before:=Workbooks("WorkbookToPasteIn").Sheets(SheetIndex)
And then, rename the sheet to fit your means.
然后，重命名工作表以适合您的方式。
