Excel VBA：在文件夹中的多个工作簿上循环工作表的简单副本
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12715074/
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
Excel VBA : Looping a simple copy of a worksheet over multiple workbooks in a folder
提问by mburke05
I'm attempting to apply a macro that would copy and paste one specific worksheet (call the title of that worksheet "x") from one workBOOK ("x1") , onto a master workBOOK (call that workBOOK "xmaster"), after it copy and pastes the worksheet from workbook x1 it should also rename the title of the worksheet "x" to cell B3. This should be done before it moves to the next workbook.
我正在尝试应用一个宏，该宏可以将一个特定工作表（将该工作表的标题称为“x”）从一个工作簿（“x1”）复制并粘贴到主工作簿（称该工作簿“xmaster”）上，之后它从工作簿 x1 复制并粘贴工作表，它还应该将工作表的标题“x”重命名为单元格 B3。这应该在它移动到下一个工作簿之前完成。
It would need to do this for workBOOK x1 through, say, x100. I cannot refer to the workbook by name though, because they are each named a string of text that is in no real sortable method.
它需要为 workBOOK x1 到 x100 执行此操作。但是，我不能按名称引用工作簿，因为它们每个都被命名为一个没有真正可排序方法的文本字符串。
This code I know works, copying "x" from "x1" to "xmaster", along with renaming the sheet, and breaking the links, is the following:
我知道这段代码有效，将“x”从“x1”复制到“xmaster”，同时重命名工作表并断开链接，如下所示：
Sub CombineCapExFiles()
Sheets("Capital-Projects over 3K").Move After:=Workbooks("CapEx Master File.xlsm").Sheets _
(3)
ActiveSheet.Name = Range("B3").Value
Application.DisplayAlerts = False
For Each wb In Application.Workbooks
Select Case wb.Name
Case ThisWorkbook.Name, "CapEx Master File.xlsm"
' do nothing
Case Else
wb.Close
End Select
Next wb
Application.DisplayAlerts = True
End Sub
The Activate Previous window isn't working, also not sure how to fix that portion of it.
激活上一个窗口不起作用，也不知道如何修复它的那部分。
I'm not sure how to build this to loop through all workBOOKs in the directory, however.
但是，我不确定如何构建它以遍历目录中的所有工作簿。
Should I use this:?
我应该使用这个：？
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'change to xlsm if needed ?
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
'Your code here
strFilename = Dir()
Loop
An additional constraint is that it needs to not run the macro on xmaster (it will have an error because it will not have the sheet "x" which will be renamed from the previous workbooks.)
另一个约束是它不需要在 xmaster 上运行宏（它会出错，因为它没有将从以前的工作簿重命名的工作表“x”。）
Thanks! Matthew
谢谢！马修
回答by scott
like this? (not tested)
像这样？（未测试）
Option Explicit
Sub LoopFiles()
Dim strDir As String, strFileName As String
Dim wbCopyBook As Workbook
Dim wbNewBook As Workbook
Dim wbname as String
strDir = "C:\"
strFileName = Dir(strDir & "*.xlsx")
Set wbNewBook = Workbooks.Add 'instead of adding a workbook, set = to the name of your master workbook
wbname = ThisWorkbook.FullName
Do While strFileName <> ""
Set wbCopyBook = Workbooks.Open(strDir & strFileName)
If wbCopyBook.FullName <> wbname Then
wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
wbCopyBook.Close False
strFileName = Dir()
Else
strFileName = Dir()
End If
Loop
End Sub
回答by Jamie Bull
This bit will work to avoid running the macro on xmaster.
此位将避免在 xmaster 上运行宏。
xmaster = "filename for xmaster"
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xls*", vbNormal) 'this will get .xls, .xlsx, .xlsm and .xlsb files
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
If strFileName = xmaster Then ' skip the xmaster file
strFilename = Dir()
End If
'Your code here
strFilename = Dir()
Loop
I can't help on the other part though. I don't see any Activate Previous window part in your code.
但另一方面我也帮不上忙。我在您的代码中没有看到任何 Activate Previous window 部分。
