简体   繁体   中英

Copy visible columns only from Excel worksheet as CSV file in VB6 without using copy command

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM