Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 将多个工作簿合并到单个工作簿中_Excel_Vba - Fatal编程技术网

Excel 将多个工作簿合并到单个工作簿中

Excel 将多个工作簿合并到单个工作簿中,excel,vba,Excel,Vba,我在不同的excel中有分区数据。我想创建一个宏,将所有excel文件合并到新的工作表中 我尝试了下面的代码,但它不工作 Sub CopyBooks() Application.ScreenUpdating = False Application.Calculation = xlManual Dim destinationWorkbook As Workbook Set destinationWorkbook = ThisWorkbook Dim

我在不同的excel中有分区数据。我想创建一个宏,将所有excel文件合并到新的工作表中

我尝试了下面的代码,但它不工作

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

    Dim destinationWorkbook As Workbook
    Set destinationWorkbook = ThisWorkbook
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Const path As String = "C:\Corporate Competition\Excel\merge\"
    Dim file As Variant

    Dim currentSheets As Long
    currentSheets = destinationWorkbook.Sheets.Count

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

    While file <> ""
        Set sourceWorkbook = Workbooks.Open(path & file)
        For Each sourceWorksheet In sourceWorkbook.Worksheets
            sourceWorksheet.Copy
            lCopyLastRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, "A").End(xlUp).Row
            lDestLastRow = currentSheets.Cells(ThisWorkbook.Rows.Count, "A").End(xlUp).Offset(1).Row
            sourceWorksheet.Range("A2:D" & lCopyLastRow).Copy _
            ThisWorkbook.Range("A" & lDestLastRow)
            Next
        sourceWorkbook.Close savechanges:=False
        file = Dir
    Wend

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

End Sub
子副本()
Application.ScreenUpdating=False
Application.Calculation=xlManual
将目标工作簿设置为工作簿
设置目标工作簿=此工作簿
昏暗的天空和漫长的天空一样
昏暗的天空和漫长的天空一样
将源工作簿设置为工作簿
将源工作表设置为工作表
Const path As String=“C:\Corporate Competition\Excel\merge\”
作为变量的Dim文件
将当前图纸变长
currentSheets=destinationWorkbook.Sheets.Count
file=Dir(路径和“**.xls**”)
而文件“”
设置sourceWorkbook=Workbooks.Open(路径和文件)
对于sourceWorkbook.Worksheets中的每个sourceWorksheet
源工作表。复制
lCopyLastRow=sourceWorksheet.Cells(sourceWorksheet.Rows.Count,“A”).End(xlUp).Row

lDestLastRow=currentSheets.Cells(ThisWorkbook.Rows.Count,“A”).End(xlUp).Offset(1).行 sourceWorksheet.Range(“A2:D”和lCopyLastRow).复制_ ThisWorkbook.Range(“A”和lDestLastRow) 下一个 sourceWorkbook.Close savechanges:=False file=Dir 温德 Application.Calculation=xlAutomatic Application.ScreenUpdating=True 端接头

我希望所有文件都一个接一个地追加。此外,一个列名称来指示区域名称/excel文件名也会很有帮助。

什么不起作用?你有错误吗?您是否得到意外的输出?etc…lDestLastRow=currentSheets.Cells(ThisWorkbook.Rows.Count,“A”)。End(xlUp)。Offset(1)。行。我收到此行错误,找不到成员。
currentSheets
是一个数字。您的意思是使用工作簿中的最后一张工作表来查找目标的最后一行吗?您可能需要类似于
工作表(currentSheets).Cells的内容(…
,如果是这样的话。另外,仅供参考,您可以删除
行前面的
此工作簿
。计数
,因为所有工作簿的总行数都相同。我正在使用lCopyLastRow从一个excel复制数据,并在目标文件中找到要复制的第一个空行。什么不起作用?您是否收到错误?您是否收到错误消息预期输出?etc…lDestLastRow=currentSheets.Cells(ThisWorkbook.Rows.Count,“A”).End(xlUp).Offset(1).Row.此行有一个错误,找不到成员。
currentSheets
是一个数字。是否使用工作簿中的最后一页来查找目标最后一行?您可能需要类似于
工作表的内容(currentSheets).单元格(…
,如果是这样的话)。另外,仅供参考,您可以删除
行前面的
Thisworkbook
。计数
,因为所有工作簿的总行数都相同。我正在使用lCopyLastRow从一个excel复制数据,并在目标文件中找到要复制到那里的第一个空行。