☰

将多个 Excel 工作簿复制到一个工作簿中

tag-icon • tag-icon microsoft-excel vba
将多个 Excel 工作簿复制到一个工作簿中

我正在尝试将多个 Excel 工作簿复制到一个工作簿中，并且每个复制的工作簿都有自己的选项卡。

我不知道如何使用 VB，所以我尝试使用 Google 找到的许多 VB 脚本，但由于这样或那样的原因（错误 9、错误 91、没有任何反应、所有工作簿都被复制到一个选项卡中）我没有成功完成。

答案1

如果你没有很多工作簿，你可以按照以下步骤手动完成这些说明.相关摘录：

  • 右键单击要移动的选项卡并选择move or copy
  • 在下拉列表中选择目标书籍
  • 选择目标书中的标签位置
  • 点击ok

如果你有很多工作簿，你可以按照以下步骤实现自动化这些说明。 相关摘录：

  • 将所有工作簿放在同一目录中，并记下目录路径
  • 打开目标工作簿
  • 点击Developer->Visual Basic
  • 在新窗口中，点击Insert->Module

  • 粘贴以下代码：

    Sub GetSheets()
Path = "<INSERT PATH TO DIRECTORY HERE>"
Filename = Dir(Path & "*.xls*")
  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

  • 将该行替换Path为包含工作簿的目录的完整路径

  • 单击green arrow button运行代码并合并工作簿。

答案2

这有效 -

    Sub CopyBooks()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Dim destinationWorkbook As Workbook
    Set destinationWorkbook = ThisWorkbook
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Const path As String = "C:\your\path\"
    Dim file As Variant

    Dim currentSheets As Long
    currentSheets = destinationWorkbook.Sheets.Count

    file = Dir(path & "*.xl*")

    While file <> ""
        Set sourceWorkbook = Workbooks.Open(path & file)
            For Each sourceWorksheet In sourceWorkbook.Worksheets
                sourceWorksheet.Copy after:=destinationWorkbook.Worksheets(currentSheets)
                currentSheets = currentSheets + 1
            Next
            sourceWorkbook.Close savechanges:=False
            file = Dir
    Wend

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    End Sub

相关内容