Enregistrer des colonnes spécifiques au nouveau fichier xlsx avec vbscript

Question

J'ai un fichier xlsx avec beaucoup de colonnes et de lignes. J'ai besoin de sélectionner des colonnes spécifiques pour générer un nouveau fichier xlsx.
Mon code est:

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() 

Mais cela ne copie pas toute la colonne. Comment puis-je réparer cela?

Answer 1

Je n'ai pas pu répliquer votre erreur mais voici quelques pointeurs.

Vous ne devez pas utiliser de parenthèses appelant un sous-marin et essayez également de l'enregistrer sous un format de fichier différent: objWorkbook.SaveAs("C:\test.xls").

Ici seule la dernière copie est en cours de copie:

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

Une meilleure façon est d'utiliser Columns et .Copy Destination pour copier les données.

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 

---

Voici comment vous pouvez copier les données d'une colonne en commençant à une ligne spécifique.

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