在Excel中使用VBA合并工作簿并重命名导入的工作表

我试图将一个特定目录中的所有XLS文件导入到一个工作簿中。 我已经尝试了几个代码的来源，最近我来了下面的（closures导入的工作簿时，所有其他抱怨，无论我尝试）。

我现在要做的就是从合并单元格（C7和D7）中取出文本，并将新的工作表重命名为该工作表。 （在单元格中有一个回车符，如果这有影响的话，我不能控制源文件，因为它们是由外部团队产生的）。

恐怕我几乎没有任何编码的能力，但是我通常可以阅读其他来源的代码，但是我在这里难倒了。 我设法让它重命名为源文件名，但我宁愿从单元格文本中获取它。

干杯!

Sub Merge2MultiSheets() Dim wbDst As Workbook Dim wbSrc As Workbook Dim wsSrc As Worksheet Dim MyPath As String Dim strFilename As String Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False MyPath = "C:\Temp\" ' change to suit Set wbDst = Workbooks.Add(xlWBATWorksheet) strFilename = Dir(MyPath & "\*.xls", vbNormal) If Len(strFilename) = 0 Then Exit Sub Do Until strFilename = "" Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename) Set wsSrc = wbSrc.Worksheets(1) wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count) ActiveSheet.Name = wsSrc.Range("C7").Value wbSrc.Close False strFilename = Dir() Loop wbDst.Worksheets(1).Delete Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub 

Answer 1

• 我会改变这一行：
  ActiveSheet.Name = wsSrc.Range("C7").Value
  至：
  wbDst.Worksheets(wbDst.Worksheets.Count).Name = wsSrc.Range("C7")
  这将确保您在目标工作簿中命名工作表，而不是在源工作簿中使用ActiveSheet

• 从关于你的文件的顺序的评论中你的问题：
  （顺便说一句 – 你应该编辑你的文章，并把问题放在那里，评论可以被删除）
  顺序由操作系统保存文件的“自然”sorting顺序决定。 我还没有find任何标志，可以添加到Dir()命令来sorting他们的input。
  如果您需要按名称顺序处理它们，我会build议：

  1. 在wbDst创build一个临时表
  2. 使用Dir()遍历所有文件，将它们放在Range(A1:An)
     • 即把第一个文件名放在Range（“A1”）中，第二个文件名放在Range（“A2”）中，等等
  3. sortingRange(A1:An)以便它们按照所需的顺序
  4. 循环你现在sorting的Range()来做实际的处理
  5. 完成处理后，从wbDst删除临时表

• 现在，注释掉：
  Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
  在代码中这些都是很棒的东西，但是直到一切正常

• 我会build议改变：
  If Len(strFilename) = 0 Then Exit Sub
  至
  If Len(strFilename) > 0 Then
Do Until...
Loop
  因为，如果你最初的目录读取没有给你任何文件，你的循环之后永远不会得到清理好的代码。 目前，这里没有什么关键的，但是你可以在将来修改代码，或者将其用作其他代码的模型，这将需要进行重要的清理，这是一个很好的习惯。