Forum Discussion

Ocasio27's avatar
Ocasio27
Iron Contributor
Apr 17, 2020

Modify macro for CSV

I have this code, it will create one .csv file with header and row for each row in a table. I copies from another place and did some minor modifications, now what I need is to add a way so the macro...
  • Riny_van_Eekelen's avatar
    Riny_van_Eekelen
    Apr 21, 2020

    Ocasio27

    Adjusted your code a little bit. You need to include your variables "sWorkbookPath" and "fName" in the code that saves the workbook. But before that, you must pick-up the file name within the loop, so that it starts with A2, then A3, then A4 etc. 

    See if you can get it to work. If not, come back!

     

    Sub SaveCSVfiles()
        Dim last_row As Long
        last_row = Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
        Dim sWorkbookPath As String
        Dim fName As String
    
        sWorkbookPath = ActiveWorkbook.Path
        MsgBox "Active Workbook Path is : " & sWorkbookPath, vbInformation, "VBAF1"
        Const NumRows As Integer = 1
        Const HeaderRow As Integer = 1
        
        Dim iRow As Integer, startSheet As Worksheet, tmpSheet As Worksheet
        
        Application.ScreenUpdating = False
    
        iRow = HeaderRow + 1
        Set startSheet = ActiveSheet
        Do Until iRow > last_row + HeaderRow
            Set tmpSheet = Worksheets.Add
            
            fName = startSheet.Range("A" & iRow)
            
            'copy the header
            startSheet.Range(HeaderRow & ":" & HeaderRow).EntireRow.Copy tmpSheet.Range("A1")
            'copy the data
            startSheet.Range(iRow & ":" & (iRow + NumRows - HeaderRow)).EntireRow.Copy tmpSheet.Range("A2")
            'save tmpSheet to CSV file
            tmpSheet.Move
            With ActiveWorkbook
                .SaveAs Filename:=sWorkbookPath & fName & (iRow + NumRows - HeaderRow - 1) & ".csv", FileFormat:=xlCSVMSDOS
                .Close True
            End With
            iRow = iRow + NumRows
        Loop
        
        Application.ScreenUpdating = True
        
    End Sub

     

Resources