none
Save Named Worksheets in Workbook to CSV RRS feed

  • Question

  • Hi All,

    I have a workbook with multiple worksheets and the code below works fine but saves all the worksheets to CSV. 

    1) I want to  specify in the code to save worksheets with names ( Dwelling, Tenancy, Resident and Rent) to CSV.

    2) Delete Blank Rows from the CSV worksheets

    Public Sub WriteCSV()
     
        Dim iFile As Integer
        Dim strText As String, strFileName As String
        Dim lngCol As Long, lngRow As Long
        Dim wks As Worksheet
     
        iFile = FreeFile()
     
        For Each wks In ActiveWorkbook.Worksheets
            If wks.Visible = xlSheetVisible Then
                strFileName = ActiveWorkbook.Path & "\" & wks.Name & "_" & Format(Date, "YYYYMMDD") & "_" & Format(Time, "HHMM") & ".csv"
                Open strFileName For Output As #iFile
                    For lngRow = 1 To wks.UsedRange.Rows.Count
                        For lngCol = 1 To wks.UsedRange.Columns.Count
                            Print #iFile, wks.Cells(lngRow, lngCol).Text & ",";
                        Next lngCol
                            Print #iFile,
                    Next lngRow
                Close #iFile
            End If
        Next wks
       MsgBox "The CSV Files have been Created and Saved under:  " & ActiveWorkbook.Path & "\"
       
    End Sub

    Tuesday, December 23, 2014 3:21 AM

Answers

  • I got this as below


    Sub ExportWorksheets()

      Dim strFILE_PATH        As String
      Dim varExportSheets     As Variant
      Dim wksInActiveWorkbook As Worksheet
      Dim blnExport           As Boolean
      Dim intSheetNum         As Integer
      Dim strFileName         As String
      Dim intFileNum          As Integer
      Dim rngToExport         As Range
      Dim lngRowNum           As Long
      Dim intColNum           As Integer
      Dim a_varRowOfData()    As String
      Dim strRowOfData        As String
     
      varExportSheets = Array("Estate_SLDWELLING", "Estate_SLTENANCY", "Estate_SLHOUSEHOLD", "Estate_SLRESIDENT", "Estate_SLRENT")
      For Each wksInActiveWorkbook In ActiveWorkbook.Worksheets
        blnExport = False
        For intSheetNum = LBound(varExportSheets) To UBound(varExportSheets)
          If wksInActiveWorkbook.Name = varExportSheets(intSheetNum) Then
            blnExport = True
            Exit For
          End If
        Next intSheetNum
        If blnExport Then
          strFileName = "C:\Test" & wksInActiveWorkbook.Name & "_" & Format(Date, "YYYYMMDD") & "_" & Format(Time, "HHMM") & ".csv"
          intFileNum = FreeFile()
          Open strFILE_PATH & strFileName For Output As #intFileNum
          Set rngToExport = wksInActiveWorkbook.UsedRange
          For lngRowNum = 1 To rngToExport.Rows.Count
            If WorksheetFunction.CountA(rngToExport.Rows(lngRowNum)) > 0 Then
              ReDim a_varRowOfData(1 To 1)
              For intColNum = 1 To rngToExport.Columns.Count
                ReDim Preserve a_varRowOfData(1 To intColNum)
                a_varRowOfData(intColNum) = rngToExport.Cells(lngRowNum, intColNum).Value
              Next intColNum
              strRowOfData = Join$(a_varRowOfData, ",")
              Print #intFileNum, strRowOfData
            End If
          Next lngRowNum
         Close #intFileNum
        End If
      Next wksInActiveWorkbook
     
      MsgBox "The CSV Files have been Created and Saved under: C:\Test"

    End Sub

    • Marked as answer by jaggy99 Monday, January 5, 2015 1:14 PM
    Monday, January 5, 2015 1:14 PM

All replies

  • Hi jaggy99,

    For this requirement, you could check the worksheet name, then write to CSV file.

      If wks.Visible = xlSheetVisible And (wkx.Name="Dwelling Or wkx.Name="Tenancy") Then

    To remove the blank rows, I suggest that you could check the value of cell first, if it has value, then print it.

    If IsEmpty(wks.Cells(lngRow, lngCol)) Then

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, December 24, 2014 7:30 AM
    Moderator
  • I got this as below


    Sub ExportWorksheets()

      Dim strFILE_PATH        As String
      Dim varExportSheets     As Variant
      Dim wksInActiveWorkbook As Worksheet
      Dim blnExport           As Boolean
      Dim intSheetNum         As Integer
      Dim strFileName         As String
      Dim intFileNum          As Integer
      Dim rngToExport         As Range
      Dim lngRowNum           As Long
      Dim intColNum           As Integer
      Dim a_varRowOfData()    As String
      Dim strRowOfData        As String
     
      varExportSheets = Array("Estate_SLDWELLING", "Estate_SLTENANCY", "Estate_SLHOUSEHOLD", "Estate_SLRESIDENT", "Estate_SLRENT")
      For Each wksInActiveWorkbook In ActiveWorkbook.Worksheets
        blnExport = False
        For intSheetNum = LBound(varExportSheets) To UBound(varExportSheets)
          If wksInActiveWorkbook.Name = varExportSheets(intSheetNum) Then
            blnExport = True
            Exit For
          End If
        Next intSheetNum
        If blnExport Then
          strFileName = "C:\Test" & wksInActiveWorkbook.Name & "_" & Format(Date, "YYYYMMDD") & "_" & Format(Time, "HHMM") & ".csv"
          intFileNum = FreeFile()
          Open strFILE_PATH & strFileName For Output As #intFileNum
          Set rngToExport = wksInActiveWorkbook.UsedRange
          For lngRowNum = 1 To rngToExport.Rows.Count
            If WorksheetFunction.CountA(rngToExport.Rows(lngRowNum)) > 0 Then
              ReDim a_varRowOfData(1 To 1)
              For intColNum = 1 To rngToExport.Columns.Count
                ReDim Preserve a_varRowOfData(1 To intColNum)
                a_varRowOfData(intColNum) = rngToExport.Cells(lngRowNum, intColNum).Value
              Next intColNum
              strRowOfData = Join$(a_varRowOfData, ",")
              Print #intFileNum, strRowOfData
            End If
          Next lngRowNum
         Close #intFileNum
        End If
      Next wksInActiveWorkbook
     
      MsgBox "The CSV Files have been Created and Saved under: C:\Test"

    End Sub

    • Marked as answer by jaggy99 Monday, January 5, 2015 1:14 PM
    Monday, January 5, 2015 1:14 PM