Este código VBA funcionará:
Public Sub tojson()
savename = "exportedxls.json"
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
Dim titles() As String
ReDim titles(lcolumn)
For i = 1 To lcolumn
titles(i) = wks.Cells(1, i)
Next i
json = "["
dq = """"
For j = 2 To lrow
For i = 1 To lcolumn
If i = 1 Then
json = json & "{"
End If
cellvalue = wks.Cells(j, i)
json = json & dq & titles(i) & dq & ":" & dq & cellvalue & dq
If i <> lcolumn Then
json = json & ","
End If
Next i
json = json & "}"
If j <> lrow Then
json = json & ","
End If
Next j
json = json & "]"
myFile = Application.DefaultFilePath & "\" & savename
Open myFile For Output As #1
Print #1, json
Close #1
a = MsgBox("Saved as " & savename, vbOKOnly)
End Sub
Abra o VBA / Macros com ALT + F11 .
No lado esquerdo, clique duas vezes em A planilha, no lado direito, cole o código.
Defina a variável savename
com o nome que você deseja para o arquivo json e isso é tudo.