从多个Excel文件复制列的数据并将其粘贴到新的Excel文件中

我想复制位于文件夹中的Excel文件中的特定列，并将所有值粘贴到新的Excel表格中。

Completed-

1. 我能够遍历文件夹中的所有文件。
2. 我能够从特定的列复制数据。

无法完成：

1. 无法粘贴复制的数据。
2. 我只想复制不同的值。
3. 我想复制列直到行在那里。 如果有7行，那么复制7列的值。 我的复制命令是复制到excel工作表的最后一行的所有值。

我的代码（VBScipt） –

strPath="C:\Test" Set objExcel= CreateObject("Excel.Application") objExcel.Visible= True Set objExcel2= CreateObject("Excel.Application") objExcel2.Visible= True objExcel2.Workbooks.open("C:\Test\New Folder\4.xlsx") Set objFso = CreateObject("Scripting.FileSystemObject") Set objFolder = objFso.GetFolder (strPath) For Each objFile In objFolder.Files If objFso.GetExtensionName(objFile.Path) = "xlsx" Then objExcel.Workbooks.Open(objFile.Path) Set Source=objExcel.Activeworkbook.Sheets(1).Columns("G") Source.Copy Set dest=objExcel2.Activeworkbook.Sheets(1).Columns("A") dest.Paste objExcel.Activeworkbook.save objExcel.Activeworkbook.close objExcel2.Activeworkbook.save objExcel2.Activeworkbook.close End If Next 

Answer 1

该函数将返回工作表上给定列的使用范围。

 Private Function getRange(ByVal ColumnName As String, ByVal Sheet As Worksheet) As Range Set getRange = Sheet.Range(ColumnName & "1", ColumnName & Sheet.Range(ColumnName & Sheet.Columns(ColumnName).Rows.Count).End(xlUp).Row) End Function 

如果你使用Set Source=objExcel.Activeworkbook.Sheets(1).Columns("G")你应该做你想要的。

例如： Set Source = getRange("G", objExcel.Activeworkbook.Sheets(1))

你可能需要改变你的dest到一个单元格而不是列（如果Excel的呻吟约它是错误的大小）

Set dest = objExcel.Activeworkbook.Sheets(1).Cells("A1")

只是看到你把它标记为VBScript，我没有将它作为VBS进行testing，但是它可能和VBA一样。

Answer 2

对于使用不同的复制.AdvancedFilter()方法，使用getRange()定义单元格。 为了从文件添加数据，为每个文件创build新的工作表，然后将数据过滤到它。 我希望这有帮助。
VBScript中

 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 = 7 ' Source column index, eg 7 for "G" strPathDst = "C:\Test\New Folder\4.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) objSheetSrc.Cells(1, iColSrc).Insert xlDown objSheetSrc.Cells(1, iColSrc).Value = "TempHeader" Set objRangeSrc = GetRange(iColSrc, objSheetSrc) If objRangeSrc.Cells.Count > 1 then nNextRow = GetRange(iColDst, objSheetTmp).Rows.Count + 1 objRangeSrc.AdvancedFilter xlFilterCopy, , objSheetTmp.Cells(nNextRow, iColDst), True objSheetTmp.Cells(nNextRow, iColDst).Delete xlUp Set objRangeTmp = GetRange(iColDst, objSheetTmp) Set objSheetDst = objWorkBookDst.Worksheets.Add objRangeTmp.AdvancedFilter xlFilterCopy, , objSheetDst.Cells(1, iColDst), True objSheetTmp.Delete Set objSheetTmp = objSheetDst End If objWorkBookSrc.Close Next objSheetTmp.Cells(1, iColDst).Delete xlUp objExcel.DisplayAlerts = True Function GetRange(iColumn, objSheet) With objSheet Set GetRange = .Range(.Cells(1, iColumn), .Cells(.Cells(.Cells.Rows.Count, iColumn).End(xlUp).Row, iColumn)) End With End Function 

Answer 3

我认为PasteSpecial将帮助粘贴在VB脚本。 最好在PasteSpecial中使用-4163参数来确保只有值被粘贴。 下面的代码在Microsoft Visual Studio 2012中为我工作。添加注释只是为了知道程序在代码中的位置。 希望这可以帮助。

 Imports System.Data.OleDb Imports System.IO Imports System.Text Public Class Form1 Dim objCSV, objExcel, objSourceWorkbook, objDestWorkbook, objCSVWorkSheet, objXLSWorkSheet, srcCPUXrange, srcCPUYrange, srcMEMYrange, dstCPUXrange, dstCPUYrange, dstMEMYRange Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 'Create and open source CSV object Label1.Text = "Setting Source" objCSV = CreateObject("Excel.Application") objCSV.Visible = True objSourceWorkbook = objCSV.Workbooks.Open("C:\SourceFile.csv") Label1.Text = "Source set" 'Create and open destination Excel object Label1.Text = "Setting Destination" objExcel = CreateObject("Excel.Application") objExcel.Visible = True objDestWorkbook = objExcel.Workbooks.Open("C:\DestinationFile.xlsx") Label1.Text = "Destination Set" 'Select desired range from CSV file Label1.Text = "Copying Data" objCSVWorkSheet = objSourceWorkbook.Worksheets(1) objCSVWorkSheet.Activate() objSourceWorkbook.Worksheets(1).Range("A1").EntireColumn.Copy() Label1.Text = "Data Copied" 'Paste in Excel workbook Label1.Text = "Pasting Data" objXLSWorkSheet = objDestWorkbook.Worksheets(1) objXLSWorkSheet.Activate() objDestWorkbook.Worksheets(1).Range("A2").PasteSpecial(-4163) Label1.Text = "Data Pasted" End Sub End Class