使用vbscript将特定列保存到新的xlsx文件中

我有一个xlsx文件有很多列和行。 我需要select具体的列来生成一个新的xlsx文件。
我的代码是：

Public Sub xlsToCsv() Dim WorkingDir WorkingDir = "C:\test.xlsx" Dim fso, FileName, SaveName, myFile Dim objExcel, objWorkbook Set fso = CreateObject("Scripting.FilesystemObject") Set myFile = fso.GetFile(WorkingDir) Set objExcel = CreateObject("Excel.Application") objExcel.Visible = False objExcel.DisplayAlerts = False Set objWorkbook = objExcel.Workbooks.Open(myFile) With objWorkbook.Sheets(1) .Range("D87", .Range("D87").End(-4121)).Copy objWorkbook.Sheets.Add().paste .Range("E87", .Range("E87").End(-4121)).Copy End With dim sheet: set sheet = objWorkbook.Sheets.Add() sheet.paste objWorkbook.SaveAs("E:\test.csv"), 23 objWorkbook.Saved = true objWorkbook.Close Set objWorkbook = Nothing Set objExcel = Nothing Set fso = Nothing Set myFolder = Nothing End Sub call xlsToCsv() 

但是这并不复制整个列。 我怎样才能解决这个问题？

Answer 1

我无法复制你的错误，但这里有几点。

你不应该使用括号来调用一个sub，并且试图把它另存为一个不同的文件格式： objWorkbook.SaveAs("C:\test.xls") 。

这里只复制最后一个复制范围：

 objWorkbook.Sheets(1).Range("D8").EntireColumn.Copy objWorkbook.Sheets(1).Range("A8").EntireColumn.Copy objWorkbook.Sheets(1).Range("F8").EntireColumn.Copy 

更好的方法是使用Columns和.Copy Destination复制数据。

 objWorkbook.Sheets(1).Columns("D").Copy sheet.Columns("A") 

---

 Const WorkingDir = "C:\" Const xlCSVMSDOS = 24 Dim fso, SaveName, myFile Dim objExcel, objWorkbook, wsSource, wsTarget myFile = "test.xlsx" SaveName =WorkingDir & "test.csv" With CreateObject("Scripting.FilesystemObject") If Not .FileExists(WorkingDir & myFile) Then MsgBox "File not found:" & vbCrLf & WorkingDir & myFile, vbInformation, "Script Cancelled" WScript.Quit End If End With Set objExcel = CreateObject("Excel.Application") objExcel.Visible = False objExcel.DisplayAlerts = False Set objWorkbook = objExcel.Workbooks.Open(WorkingDir & myFile) Set wsSource = objWorkbook.Sheets(1) set wsTarget = objWorkbook.Sheets.Add() wsSource.Columns("D").Copy wsTarget.Columns("A") wsSource.Columns("A").Copy wsTarget.Columns("B") wsSource.Columns("F").Copy wsTarget.Columns("C") objWorkbook.SaveAs SaveName, xlCSVMSDOS objWorkbook.Close False 

---

以下是如何从特定行开始复制列中的数据。

 Const xlUp = -4162 With wsSource .Range("D87", .Range("D" & .Rows.Count).End(xlUp)).Copy wsTarget.Range("A1") .Range("A87", .Range("A" & .Rows.Count).End(xlUp)).Copy wsTarget.Range("B1") .Range("F87", .Range("F" & .Rows.Count).End(xlUp)).Copy wsTarget.Range("C1") End With