我的代码将所有工作簿合并到单独的工作表中. 我需要将所有内容合并到一张相同的工作表中

Question

我试图通过浏览和选择多个工作簿并获取当前工作簿中的所有数据来合并工作簿。我需要在一张纸中保存所选工作簿的所有数据。但是我的代码给出了当前工作簿的不同工作表。床单。复制后：=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count(按照这一行，语法允许我选择之后或之前，但不提供当前。请帮帮我

Dim files, i As Integer
Dim dailogbox As FileDialog
Dim mainWorkbook, sourceWorkbook As Workbook
Dim sheets As Worksheet
Set mainWorkbook = Application.ActiveWorkbook
Set dailogbox = Application.FileDialog(msoFileDialogFilePicker)
dailogbox.AllowMultiSelect = True
files = dailogbox.Show
For i = 1 To dailogbox.SelectedItems.Count
Workbooks.Open dailogbox.SelectedItems(i)
Set sourceWorkbook = ActiveWorkbook
For Each sheets In sourceWorkbook.Worksheets
sheets.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Next tempWorkSheet
sourceWorkbook.Close
Next i 

Answer 1

正如你所发现的，Sheets.Copy将复制或移动整个工作表。它不会将数据合并到另一个工作表中。您将必须复制要复制的工作表的单元格，

dim dest as Range
For i = 1 To dailogbox.SelectedItems.Count
Workbooks.Open dailogbox.SelectedItems(i)
Set sourceWorkbook = Workbooks.Open(dailogbox.SelectedItems(i))
For Each aSheet In sourceWorkbook.Worksheets '
set dest = mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)        
aSheet.Cells.Copy dest.Cells
Next sheets   ' NOT "tempWorkSheet"
sourceWorkbook.Close
Next i 

另外："工作表"是一个保留词。不能将其用作变量。我把它改成了"aSheet"。

编辑：要在复制文本后复制格式，请在aSheet.Cells.Copy dest.Cells后添加以下内容：

dest.PasteSpecial Paste:=xlPasteFormats

Answer 2

这将打开一个文件对话框，允许您选择多个文件，然后它将循环浏览工作簿上的每个工作表，将数据从 A2 复制到数据的右下角，并将其粘贴到托管此代码的工作簿中。

您需要修改或修改的内容：
1( 托管此代码的书籍的工作表名称
2( Col 跨度(现在 A-Z(
3( 如果您的导入书籍有多个工作表，则需要为要导入的工作表设置一个条件，因为这将从每个选定的工作簿中抓取每个工作表。
4(这假设Col A没有任何空白(要确定最后一行(要复制的范围(，您需要选择最不可能有空白的列，以免丢失数据。

Option Explicit
Sub Consolidation()
Dim CurrentBook As Workbook
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("SHEETNAME?")
Dim IndvFiles As FileDialog
Dim FileIdx As Long
Dim i As Integer, x As Integer
Set IndvFiles = Application.FileDialog(msoFileDialogOpen)
With IndvFiles
.AllowMultiSelect = True
.Title = "Multi-select target data files:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For FileIdx = 1 To IndvFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(IndvFiles.SelectedItems(FileIdx))
For Each Sheet In CurrentBook.Sheets
Dim LRow1 As Long
LRow1 = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
Dim LRow2 As Long
LRow2 = CurrentBook.ActiveSheet.Range("A" & CurrentBook.ActiveSheet.Rows.Count).End(xlUp).Row
Dim ImportRange As Range
Set ImportRange = CurrentBook.ActiveSheet.Range("A2:Z" & LRow2)
ImportRange.Copy
WS.Range("A" & LRow1 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
CurrentBook.Close False
Next FileIdx
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 3

也许你在追求这个(评论中的解释(：

Option Explicit
Sub CopySheets()
Dim files As Variant, i As Long
Dim dailogbox As FileDialog
Dim mySheet As Worksheet, targetSheet As Worksheet
Set targetSheet = ActiveSheet ' set the sheet you want to collect selecte workbooks worksheets data into
Set dailogbox = Application.FileDialog(msoFileDialogFilePicker)
dailogbox.AllowMultiSelect = True
files = dailogbox.Show
For i = 1 To dailogbox.SelectedItems.Count
With Workbooks.Open(dailogbox.SelectedItems(i)) ' open and reference current workbook
For Each mySheet In .Worksheets ' loop through current workbook worksheets
mySheet.UsedRange.Copy targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Offset(1) ' copy current worksheet "used" range and paste them into target sheet from its column A first empty cell after last not empty one
Next
.Close False ' cloe current workbook, discarding changes
End With
Next
End Sub