How to import/export multicell namedrange in .csv format - vba

Question

I wanted to know is there any way to work around this code so that I can import and export named ranges and their values from a workbook to and via .csv file format.
I can successfully import or export the named ranges of single cell. But I get error while exporting the multicell named ranges as they are arrays.
Code for exporting the named ranges to csv is this
Option Explicit
Sub ExportCSV()
Dim ws As Worksheet
Dim str1 As String
Dim i As Long
Dim FinalRow As Long
Set ws = Sheets("Export")
With ws
Application.ScreenUpdating = False
ws.Activate
ws.Range("A1").Select
Selection.ListNames
FinalRow = ws.Range("B9000").End(xlUp).Row
For i = 1 To FinalRow
Cells(i, "B") = Replace(Cells(i, "B"), "$", "")
Next i
Dim fileSaveName As Variant
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.csv), *.csv")
If fileSaveName <> False Then
'Code to save the file
ws.Copy
With ActiveWorkbook
.SaveAs Filename:=fileSaveName, FileFormat:=xlCSV, CreateBackup:=False
.Close False
End With
End If
ws.Cells.Clear
End With
Worksheets("Preferences").Activate
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Data Exported Successfully at " & vbNewLine & fileSaveName, vbInformation
End Sub
Code for importing named ranges and their values is this
Option Explicit
Sub impdata()
Dim MyCSV As Workbook
Dim MyCSVPath As String
Dim MyRange As Range
Dim MyCell As Range
Dim MyNextCell As Range
Dim MyNamedRange As Range
Dim ws As Worksheet
Dim FinalRow As Long
MyCSVPath = GetFile
If MyCSVPath <> "" Then
Set MyCSV = Workbooks.Open(MyCSVPath)
Application.ScreenUpdating = False
Set ws = Sheets(1)
FinalRow = ws.Range("B90000").End(xlUp).Row
Set MyRange = MyCSV.Worksheets(1).Range("B1" & ":B" & FinalRow)
ThisWorkbook.Activate
For Each MyCell In MyRange.Cells
'Get a reference to the named range.
Set MyNamedRange = Range(ThisWorkbook.Names(MyCell.Offset(, -1).Value))
'Find the next empty cell in the named range.
Set MyNextCell = MyNamedRange.Cells(MyNamedRange.Cells.Count).End(xlUp).Offset(1)
'If the next empty cell is above the named range, then set
'it to the first cell in the range.
If MyNextCell.Row < MyNamedRange.Cells(1).Row Then
Set MyNextCell = MyNamedRange.Cells(1)
End If
'Place the value in the range.
MyNextCell = MyCell.Value
Next MyCell
End If
MyCSV.Close False
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GetFile
' Date : 23/10/2015
' Purpose : Returns the full file path of the selected file
' To Use : vFile = GetFile()
'---------------------------------------------------------------------------------------
Function GetFile(Optional startFolder As Variant = -1) As Variant
Dim fle As FileDialog
Dim vItem As Variant
Set fle = Application.FileDialog(msoFileDialogFilePicker)
With fle
.Title = "Select a File"
.AllowMultiSelect = False
.Filters.Add "Comma Separate Values", "*.CSV", 1
If startFolder = -1 Then
.InitialFileName = Application.DefaultFilePath
Else
If Right(startFolder, 1) <> "\" Then
.InitialFileName = startFolder & "\"
Else
.InitialFileName = startFolder
End If
End If
If .Show <> -1 Then GoTo NextCode
vItem = .SelectedItems(1)
End With
NextCode:
GetFile = vItem
Set fle = Nothing
End Function

Answer 1

Export Code
You've put With ws and didn't really use it your code, it'd be safer and also much more practical to do so! ;)
Here is the new export code, it will keep a master file listing your Named Ranges with the value if there is only one cell or the file name (placed in the folder "Save_as_CSV", so that you can find it to re-import it) if there is multiple cells :
Option Explicit
Sub ExportCSV()
Dim Ws As Worksheet, _
WsO As Worksheet, _
Str1 As String, _
i As Long, _
ShName As String, _
RgName As String, _
FileName As String, _
FileFullName As String, _
RgO As Range, _
FinalRow As Long, _
FileSaveName As Variant
Application.ScreenUpdating = False
Set Ws = Sheets("Export")
Set WsO = Sheets("OutPut")
With Ws
.Range("A1").ListNames
FinalRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 1 To FinalRow
If InStr(1, .Cells(i, "B"), ":") Then
'NamedRange with Multiple cellS
ShName = Replace(Replace(Split(.Cells(i, "B"), "!")(0), "=", ""), "'", "")
RgName = Replace(Split(.Cells(i, "B"), "!")(1), "$", "")
Set RgO = ThisWorkbook.Sheets(ShName).Range(RgName)
WsO.Cells.Clear
WsO.Range("A1").Resize(RgO.Rows.Count, RgO.Columns.Count).Value = RgO.Value
FileName = .Cells(i, "A") & ".csv"
FileFullName = ThisWorkbook.Path & "\Save_as_CSV\" & FileName
'Code to save the file
WsO.Copy
With ActiveWorkbook
.SaveAs FileName:=FileFullName, FileFormat:=xlCSV, CreateBackup:=False
.Close False
End With
.Cells(i, "B") = FileName
Else
'NamedRange with only one cell
.Cells(i, "B") = Replace(.Cells(i, "B"), "$", "")
End If
Next i
FileSaveName = Application.GetSaveAsFilename(fileFilter:="Excel Files (*.csv), *.csv")
If FileSaveName <> False Then
'Code to save the file
.Copy
With ActiveWorkbook
.SaveAs FileName:=FileSaveName, FileFormat:=xlCSV, CreateBackup:=False
.Close False
End With
End If
.Cells.Clear
End With
Worksheets("Preferences").Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Data Exported Successfully at " & vbNewLine & FileSaveName, vbInformation
End Sub
Import Code
MyNextCell = MyCell.Value (I think MyCell.Value is the address of the named range) should be :
MyNextCell.Resize(Range(MyCell.Value).Rows.Count, _
Range(MyCell.Value).Columns.Count).Value = _
Sheets(Names(MyCell.Value).RefersToRange.Parent.Name).Range(MyCell.Value).Value
If you work with CSV, this might be better Set MyCSV = Workbooks.Open(MyCSVPath, Local:=True) than Set MyCSV = Workbooks.Open(MyCSVPath)
If you want to add the data to what you already have (I tilted after that you must be trying only to update it), Set MyNextCell = MyNamedRange.Cells(MyNamedRange.Cells.Count).End(xlUp).Offset(1)
(will start at the end of the named range and go up, then Offset, so it'll give you the second line of the named range)
should be :
Set MyNextCell = MyNamedRange.Cells(MyNamedRange.Cells.Count).Offset(1)