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

Question

我有一个包含大量列和行的xlsx文件。我需要选择具体的列来生成一个新的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

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

您不应该使用括号来调用子，并且还尝试将其另存为另一种文件格式：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