複製多個excel文件中的列數據並將其粘貼到新的excel文件中

Question

我想複製位於文件夾中的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到細胞而不是列（套內擅長以爲這是錯誤的大小呻吟聲）

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

剛纔看到你將它標記爲VBScript，我沒有將它作爲VBS進行測試，但它可能與VBA一樣。

Answer 2

對於獨特複製.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 

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