复制列'；从多个excel文件中删除数据，并将其粘贴到新的excel文件中

我想从文件夹中的excel文件中复制一个特定列，并将所有值粘贴到新的excel工作表中

完成-

我能够循环浏览文件夹中的所有文件

我能够从特定列复制数据

无法完成：

无法粘贴复制的数据

我只想复制不同的值

我想复制列，直到行出现为止。如果有7个 行然后复制列的7个值。我的复制命令正在复制所有 截至excel工作表最后一行的值

我的代码（VBScipt）-

---

此函数将返回工作表中给定列的使用范围

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）.单元格（“A1”）

---

刚刚看到您将其标记为VBScript，我没有将其测试为VBS，但它可能与VBA的工作原理相同。

用于不同的复制

。使用AdvancedFilter（）

方法，使用@NickSlash中的

getRange（）

定义单元格。对于从文件添加数据，将为每个文件创建新工作表，然后将数据过滤到其中。我希望这有帮助。
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, e. g. 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

---

我认为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

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