Hi Please Paste both codes and Change Red Items according to Your Need activate the Sheet where data is and run the code------------


Code:
Option Explicit

Sub SaveExcelasCSV()
    
    
    Dim strFirstCSVName     As String
    Dim strSecondCSVName    As String
    Dim strFirstTable       As String
    Dim strSecondTable      As String
    Dim strSaveLocation     As String
    
    Dim strCSV_1_Columns    As String
    Dim strCSV_2_Columns    As String
    Dim strRange            As String
    
    Dim wksAct              As Worksheet
    Dim wbkNew              As Workbook
    Dim rngUsedRng          As Range
    Dim lngLastRow          As Long
    
    ''''''''' Change According to your requirement================
    strFirstCSVName = "First"
    strSecondCSVName = "Second"
    strFirstTable = "FirstTable"
    strSecondCSVName = "SecondTable"
    strCSV_1_Columns = "A:C,E,G,I" ' Let Say Column A to C and Columns E, G, and I
    strCSV_2_Columns = "D,F,H,J:L" ' Let Say Columns D,F,H and Columns J to L    
    strSaveLocation = "C:\Users\kbdf775\Desktop\"
   '''''''''===============================================    
    Set wksAct = ActiveSheet
    Set wbkNew = Workbooks.Add(1)
    With wksAct
        Set rngUsedRng = .UsedRange
        lngLastRow = rngUsedRng.Rows.Count
        strRange = MakeRange(strCSV_1_Columns)
        .Range(strRange).Copy
        
        wbkNew.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Cells(1).Value = strFirstTable
        Application.DisplayAlerts = False
        wbkNew.SaveAs Filename:=strSaveLocation & strFirstCSVName, FileFormat:=xlCSV, CreateBackup:=False
        Application.DisplayAlerts = True
        
        wbkNew.Sheets(1).Cells.Clear
        strRange = MakeRange(strCSV_2_Columns)
        .Range(strRange).Copy
        wbkNew.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Cells(1).Value = strSecondTable
        Application.DisplayAlerts = False
        wbkNew.SaveAs Filename:=strSaveLocation & strSecondCSVName, FileFormat:=xlCSV, CreateBackup:=False
        Application.DisplayAlerts = True
        wbkNew.Close 0
    End With
End Sub
Code:
Function MakeRange(strString As String)

    Dim varSplit    As Variant
    Dim lngVar      As Long
    Dim strMain     As String
    
    varSplit = Split(strString, ",")
    
    For lngVar = 0 To UBound(varSplit)
        If Len(varSplit(lngVar)) = 1 Or InStr(1, varSplit(lngVar), ":") = 0 Then
            If strMain = "" Then
                strMain = varSplit(lngVar) & ":" & varSplit(lngVar)
            Else
                strMain = strMain & "," & varSplit(lngVar) & ":" & varSplit(lngVar)
            End If
        Else
            If strMain = "" Then
                strMain = varSplit(lngVar)
            Else
                strMain = strMain & "," & varSplit(lngVar)


            End If
        End If
    Next
    MakeRange = strMain
End Function

HTH
---------------------------------------------------------