VBS将多个Excel文件中的信息编译为一个 [英] VBS to compile information from multiple excel files into one

问题描述

我正在使用VBScript将所有信息从多个excel文件移到一个主excel文件的一张纸上.

I'm working on VBScript to move all the information from multiple excel files into one sheet on a master excel file.

基本上，这将是1000-2000行信息​​和大约20列.目录中总共将有5-6个excel文件.所有信息都在第一个选项卡上，我基本上只需要复制并粘贴它，而不会覆盖以前复制和粘贴的数据.

It would basically be 1000-2000 rows of information and about 20 columns. There would be about 5-6 total excel files in the directory. All of the information is on the first tab, I essentially just need to copy and paste it over without overwriting the previously copy and pasted data.

到目前为止，这是我遇到的问题，它是将主文件中的先前excel表格数据与最新的excel表格数据一起复制.我需要它去下一个开放单元格.

This is what I have so far, the issue I'm running into is that it copies over the previous excel sheets data in the master file with the most recent excel sheet's data. I need it to go to the next open cell.

Const xlFilterCopy = 2
Const xlUp = -4162
Const xlDown = -4121
strPathSrc = "C:\test" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
'iColSrc = 1 ' Source column index, e. g. 7 for "G"
strPathDst = "C:\test\Results\Results.xlsx" ' Destination file
'iColDst = 1 ' Destination column index

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetTmp = objWorkBookDst.Worksheets.Add
'objSheetTmp.Cells(1, iColDst).Value = "TempHeader"
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    Set objRangeSrc = objSheetSrc.UsedRange
    Set ObjSheetDst = objWorkBookDst.Worksheets.Add
    objRangeSrc.AdvancedFilter xlFilterCopy, , objSheetDst.Cells(1, 1), False
    objSheetSrc.Delete
    objWorkBookSrc.Close
Next

推荐答案

您在这里！

strPathSrc = "C:\test" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
strPathDst = "C:\test\Results\Results.xlsx" ' Destination file
iSheetDst = 1 ' Destination sheet index or name

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetDst = objWorkBookDst.Sheets(iSheetDst)
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    GetUsedRange(objSheetSrc).Copy
    Set objUsedRangeDst = GetUsedRange(objSheetDst)
    iRowsCount = objUsedRangeDst.Rows.Count
    objWorkBookDst.Activate
    objSheetDst.Cells(iRowsCount + 1, 1).Select
    objSheetDst.Paste
    objWorkBookDst.Application.CutCopyMode = False
    objWorkBookSrc.Close
Next

Function GetUsedRange(objSheet)
    With objSheet
        Set GetUsedRange = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, .UsedRange.Column + .UsedRange.Columns.Count - 1))
    End With
End Function

这篇关于VBS将多个Excel文件中的信息编译为一个的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！