将数据从许多 excel 工作簿复制到另一个 excel 工作簿答案

【问题标题】：Copying data from many excel workbook to another excel workbook将数据从许多 excel 工作簿复制到另一个 excel 工作簿
【发布时间】：2014-04-01 11:37:57
【问题描述】：

我是 vb 脚本的新手，不太了解，所以请帮忙。

我有一个文件夹，里面有很多子文件夹。每个子文件夹中有 10 多个 Excel 表。我的目标是将所有子文件夹中的每个 excel 文件中的数据复制到单个 excel 表中。问题是我写了一个代码，但它被覆盖了，所以数据被删除了。而且我们在所有 excel 文件中都有相同的标题，我希望标题在主 excel 表中只出现一次。请提前帮助和thnakyou。

'Sub RunCodeOnAllXLSFiles()
On Error Resume Next


Set objExcel = CreateObject("Excel.Application")


strPath = ":\Documents and Settings\faizat\Desktop\leeza"
pathName="xlsx"


If strPath = "" Then WScript.quit
If pathName = "" Then WScript.quit


'Creating an Excel Workbook in My Documents
Set objWorkbook2= objExcel.Workbooks.Add()


objExcel.Visible = True
objExcel.DisplayAlerts = False


Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
Set objsubFolder = objfolder.subFolders
Set objfile = objsubfolder.files


For Each objsubfolder In objfolder.subfolders

    For Each objFile In objsubFolder.Files


        If objFso.GetExtensionName (objFile.Path) = "xlsx" Then
            Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)


            Set objWorksheet = objWorkbook.WorkSheets(1)
            objworksheet.Activate


            ' Select the range on Sheet1 you want to copy 
            objWorkbook.Worksheets("SHEET1").usedrange.Copy


            objworkbook.close




            Set objRange = objExcel.Range("A2")
            intNewRow = objExcel.ActiveCell.Row + 10
            strNewCell = "A" & intNewRow
            objExcel.Range(strNewCell).Activate

            For i = 1 To usedrange
                objWorksheet.Cells(intNewRow, 1) = i * 1
                intNewRow = intNewRow + i
            Next

            ' Paste it on sheet1 of workbook2, starting at A1
            objWorkbook2.Worksheets("Sheet1").Range(strNewCell).PasteSpecial

            Set objWorksheet = objWorkbook2.Worksheets(1)

        End If
    Next
Next

【问题讨论】：

非常感谢，成功了

标签： excel vbscript

【解决方案1】：

For i = 1 To usedrange
    objWorksheet.Cells(intNewRow, 1) = i * 1
    intNewRow = intNewRow + i
Next

你永远不会初始化变量usedrange，所以你的循环永远不会增加intNewRow。在脚本开头使用值 1 初始化 intNewRow，并在内部循环中使用类似的内容：

Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)

If intNewRow = 1 Then
  startrow = 1
Else
  startrow = 2
End If
endrow = objWorkbook.Worksheets("SHEET1").UsedRange.Rows.Count

objWorkbook.Worksheets("SHEET1").Range(startrow & ":" & endrow).Copy
objWorkbook2.Worksheets("Sheet1").Cells(intNewRow, 1).PasteSpecial

objWorkbook.close

intNewRow = intNewRow + (endrow - startrow - 1)

【讨论】：