首页 文章

从许多子文件夹中的所有(许多)excel工作簿中复制数据,并将其复制到另一个excel工作簿

提问于
浏览
1

下面是循环遍历每个子文件夹中的所有excel工作簿(循环子文件夹)并从每个excel工作簿复制数据并附加到另一个excel工作簿的代码 . 超出下面的代码我得到一个错误,因为“对象不支持这个属性或方法:'objsubfolder.files'”请帮助我 .

'Sub RunCodeOnAllXLSFiles()

Set objExcel = CreateObject("Excel.Application")

strPath = "C:\Documents and Settings\SupriyaS\Desktop\su"
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 objsubfoleder in objfolder.subfolders

For Each objFile In objsubFolders.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("A1")
intNewRow = objExcel.ActiveCell.Row + 3
strNewCell = "A" &  intNewRow
objExcel.Range(strNewCell).Activate

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

Set objWorksheet = objWorkbook2.Worksheets(1)

End If
next
next

1 回答

  • 0

    作为答案发表只是为了能够说:

    USE Option Explicit

    (并在首次使用前立即对所有变量进行Dim和初始化)

    避免像“objsubfoleder”这样的拼写错误

相关问题