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

时间:2017-10-09 13:40:21

标签: excel vbscript xlsx

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

但这不会复制整个专栏。我该如何解决这个问题?

1 个答案:

答案 0 :(得分: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