将数据从许多excel工作簿复制到另一个excel工作簿 [英] Copying data from many excel workbook to another excel workbook
问题描述
我是vb脚本的新手,请多多帮助。
i am new to vb script and dont know much so please help.
我有一个文件夹,由多个子文件夹组成。每个子文件夹都有10多个Excel表格。我的目的是将数据从每个Excel文件从所有的子文件夹复制到一个excel表。问题是我已经写了一个代码,但它是覆盖,所以数据被删除。我们在所有excel文件中都有相同的标题,我希望标题在主Excel表单中只显示一次。
请提前帮助和thnakyou。
I have a folder, which consists of many sub-folders . Each sub-folder has 10+ excel sheets in it. My aim is to copy the data from each and every excel file from all the sub-folders to a single excel sheet. the problem is i have written a code, but it is overwriting so the data gets deleted. And we have same header in all the excel files, i want the header to appear only once in the main excel sheet . please help and thnakyou in advance.
'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
推荐答案
For i = 1 To usedrange
objWorksheet.Cells(intNewRow, 1) = i * 1
intNewRow = intNewRow + i
Next
初始化变量 usedrange
,所以你的循环不会递增 intNewRow
。在脚本开始时初始化 intNewRow
,值为1,并在内部循环中使用类似的内容:
You never initialize the variable usedrange
, so your loop never increments intNewRow
. Initialize intNewRow
with the value 1 at the beginning of your script, and use something like this in the inner loop:
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)
这篇关于将数据从许多excel工作簿复制到另一个excel工作簿的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!