I have Excel worksheet object in which some columns are in invisible mode. I want to save those worksheets as CSV file with visible columns only. My primary requirement is not to use Copy method and csv file should contain all visible columns with value and format .
Private Sub SaveAsCSV_TSA(ByVal xl As Excel.Application, ByVal xlsheet As Excel.Worksheet, ByVal CSVSavePath As String)
On Error GoTo BottomLine
Set xlwbook1 = xl.Workbooks.Add
Dim xlsheet1 As Worksheet
Set xlsheet1 = xlwbook1.Sheets.Item(1)
xlsheet1.Activate
xlsheet.Cells.SpecialCells(xlCellTypeVisible).Copy
xlsheet1.Paste
xl.CutCopyMode = False
xlwbook1.SaveAs FileName:=CSVSavePath, FileFormat:=xlCSV
xlwbook1.Close SaveChanges:=False
Set xlwbook1 = Nothing
Set xlsheet1 = Nothing
BottomLine:
If Not xlsheet1 Is Nothing Then Set xlsheet1 = Nothing
If Not xlwbook1 Is Nothing Then Set xlwbook1 = Nothing
If Err.number > 0 And Err.number <> cdlCancel Then
MsgBox (Err.number & Chr(13) & Err.Description & " - Create_TS_Turn_file" & vbCrLf & "Line Number: " & Erl)
End If
End Sub
In the above case, xlsheet is a source, and xlsheet1 is a destination.
Note: Why I do not need to use copy command. Since, i have repeatedly calling the above method around (1000) times with different worksheet as parameter. (I have got the problem as cannot able to do other copy/paste work on the machine which this application runs. It causes that replace my original copied content with xlsheet.Cells.SpecialCells(xlCellTypeVisible).Copy content.
Please help me to resolve this.. I need to fix it soon. Thanks in advance!
edited as per OP's further specs
not so sure what's your issue but maybe this can help:
Option Explicit
Private Sub SaveAsCSV_TSA(ByVal xl As Excel.Application, ByVal xlsheet As Excel.Worksheet, ByVal CSVSavePath As String)
Dim xlwbook1 As Workbook
Dim xlsheet1 As Worksheet
Dim cell As Range
Dim colsAddr As String
On Error GoTo BottomLine
Set xlwbook1 = xl.Workbooks.Add
With xlwbook1
xlsheet.Copy After:=.Sheets.Item(1)
With .ActiveSheet '<~~ here starts the new "treatment"
With .UsedRange
For Each cell In .Rows(1).Cells '<~~ loop through first row cells
If cell.EntireColumn.Hidden Then colsAddr = colsAddr & cell.EntireColumn.Address & "," '<~~ store cell entire column address if hidden
Next cell
.Value = .Value '<~~ get rid of formulas and keep only their resulting values
End With
If colsAddr <> "" Then .Range(Left(colsAddr, Len(colsAddr) - 1)).Delete '<~~ delete hidden columns, if any
End With '<~~ here ends the new "treatment"
.SaveAs Filename:=CSVSavePath, FileFormat:=xlCSV
.Close SaveChanges:=False
End With
Set xlwbook1 = Nothing
Set xlsheet1 = Nothing
BottomLine:
If Not xlsheet1 Is Nothing Then Set xlsheet1 = Nothing
If Not xlwbook1 Is Nothing Then Set xlwbook1 = Nothing
If Err.Number > 0 And Err.Number <> xlCancel Then
MsgBox (Err.Number & Chr(13) & Err.Description & " - Create_TS_Turn_file" & vbCrLf & "Line Number: " & Erl)
End If
End Sub
which I suggest to call like follows
Sub main()
Application.ScreenUpdating = False '<~~ stop screen updating and speed things up
SaveAsCSV_TSA Application, ActiveSheet, "yourpath"
Application.ScreenUpdating = True '<~~ resume screen updating
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.