Excel 将多个工作表复制到VBA工作簿本身

下面的代码完美地将数据从指定工作簿的活动工作表复制到新的未命名工作簿中。它从第一个文件复制第一行，并将第一（标题）行以外的其他文件中的数据与其合并

但是，我正在学习，我想知道如何以相同的方式将数据组合到宏工作簿中（而不是新工作簿中）。我打算在将数据合并到同一本宏手册中之后进行一些宏记录

请帮我怎么做。我试图将合并的工作表从新工作簿（运行以下代码后生成的工作表）移动/复制到宏工作簿中，然后关闭新工作簿而不保存它，但到目前为止没有成功。请帮忙

Option Explicit
Sub CombineDataFiles()

Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
    LastDataRow As Long, LastDataCol As Long, _
    HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range

'initialize constants
MaxNumberFiles = 2001
HeaderRow = 1 'assume headers are always in row 1
LastOutRow = 1

'prompt user to select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
End With

'error trap - don't allow user to pick more than 2000 files
If TargetFiles.SelectedItems.Count > MaxNumberFiles Then
    MsgBox ("Too many files selected, please pick more than " &     MaxNumberFiles & ". Exiting sub...")
    Exit Sub
End If

'set up the output workbook
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)

'loop through all files
For FileIdx = 1 To TargetFiles.SelectedItems.Count

    'open the file and assign the workbook/worksheet
    Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
    Set DataSheet = DataBook.ActiveSheet

    'identify row/column boundaries
    LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows,     SearchDirection:=xlPrevious).Row
    LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    'if this is the first go-round, include the header
    If FileIdx = 1 Then
        Set DataRng = Range(DataSheet.Cells(HeaderRow, 1),                     DataSheet.Cells(LastDataRow, LastDataCol))
        Set OutRng = Range(OutSheet.Cells(HeaderRow, 1),     OutSheet.Cells(LastDataRow, LastDataCol))
    'if this is NOT the first go-round, then skip the header
    Else
        Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 1), DataSheet.Cells(LastDataRow, LastDataCol))
        Set OutRng = Range(OutSheet.Cells(LastOutRow + 1, 1), OutSheet.Cells(LastOutRow + 1 + LastDataRow, LastDataCol))
    End If

    'copy the data to the outbook
    DataRng.Copy OutRng

    'close the data book without saving
    DataBook.Close False

    'update the last outbook row
    LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows,     SearchDirection:=xlPrevious).Row

Next FileIdx

'let the user know we're done!
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")

End Sub

---

将

OutBook

变量更改为reference，并将

OutSheet

更改为此工作簿中的工作表

'set up the output workbook
Set OutBook = ThisWorkbook `Workbooks.Add

您可能需要添加新的工作表：

Set OutSheet = OutBook.Sheets.Add
OutSheet.Name = "CombineDataFilesOutput"

如果经常这样做，您可能希望为工作表指定一个唯一的ID，以便可以添加多个工作表，而不用担心重复的工作表名称。我通常使用

Now（）

的某种格式来创建唯一标识：

OutSheet.Name = Format(Now(),"YYYYMMDDhhmmss")

---

我还注意到您对所选文件限制的评论似乎错误地通知了用户。你告诉他们“请选择2000多个文件”，但应该说“请选择不超过2000个文件”，或者更好的说法是“请选择不超过2000个文件”

---

非常感谢你！这是有帮助的，是的，我做了更正“太多的文件…”谢谢！我可能还有更多的问题要问。@ChetanChimate-如果你觉得答案有帮助，适当的感谢是向上投票（单击答案旁边的小向上箭头）。如果答案帮助您解决了问题，请单击答案旁边的小空

复选标记

，它将变为绿色-我将受到感谢。：）我这样做了，但它说，它不会显示，直到我获得15分或一些我新到这个网站，事实上相当新的编码和东西（作为一个机械工程师，从来没有机会探索这个迷人的编码世界）。我的下一个问题-在巩固选定的文件在宏书本身使用上述代码，我录制了宏以进行条件格式设置。现在我想强制用户不要保存宏手册，而是在代码运行后，它应该使用一些独特的信息（如“yyyymmmdd，hhmm.xlsx”）自动将该宏文件保存为“另存为”非宏文件，询问用户保存到哪里。此外，它应该在不保存宏文件的情况下关闭宏文件，并打开上次保存为.xlsx的宏文件。我发现了一些代码，但它们并不完全是我想要的。请帮忙，开始一个新问题

'error trap - don't allow user to pick more than 2000 files
If TargetFiles.SelectedItems.Count > MaxNumberFiles Then
    MsgBox ("Too many files selected, please pick less than " &     MaxNumberFiles & ". Exiting sub...")
Exit Sub
End If