[英]Copying in Excel from one workbook to another and copying cells data to another workbook
[英]Copying data from many excel workbook to another excel workbook
我是vb腳本的新手,並不了解很多,所以請幫忙。
我有一個文件夾,其中包含許多子文件夾。 每個子文件夾中都有10多個Excel表格。 我的目的是將所有子文件夾中每個Excel文件中的數據復制到一個Excel工作表中。 問題是我寫了一個代碼,但是它被覆蓋了,所以數據被刪除了。 而且我們在所有excel文件中都有相同的標題,我希望標題在主excel工作表中僅出現一次。 請提前幫助並打敗你。
'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
。 在腳本開始處用值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)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.