Из хранимой процедуры на одном сервере SQL записать данные в таблицу друго сервера SQL. VBA

Добрый день!
У меня такой вопрос.
Мне нужно из хранимой процедуры одного сервера SQL записать данные в таблицу на другой сервер SQL.
Я попробовал
Sub Test()

Dim conn As String
Dim data_base As String
Dim period As String
Dim datasource As String
Dim object_id As String
Dim dt As Integer
Dim day_start  As String
Dim date_beg  As String
Dim date_end  As String
 


conn = "Provider=SQLOLEDB.1;Password=****;Persist Security Info=True;User ID=****;Initial Catalog=TCD_Work;Data Source=***"
conn1 = "Provider=SQLOLEDB.1;Password=**;Persist Security Info=True;User ID=**;Initial Catalog=dbm_asrmb_knpz_20190129;Data Source=***"


JS_params = "{" + Chr(34) + "id_object" + Chr(34) + ":" + Chr(34) + object_id + Chr(34) + "," _
                + Chr(34) + "period" + Chr(34) + ":" + Chr(34) + period + Chr(34) + "," _
                + Chr(34) + "datasource" + Chr(34) + ":" + Chr(34) + CStr(dt) + Chr(34) + "," _
                + Chr(34) + "date" + Chr(34) + ":" + Chr(34) + day_start + Chr(34) + "," _
                + Chr(34) + "date_beg" + Chr(34) + ":" + Chr(34) + date_beg + Chr(34) + "," _
                + Chr(34) + "date_end" + Chr(34) + ":" + Chr(34) + date_end + Chr(34) + "}"
                
Query conn, JS_params

End Sub

Sub Query(connStr As String, jsonParams As String)



Dim cnDB As New ADODB.Connection
Dim rc As New ADODB.Recordset
cnDB.CommandTimeout = 360
cnDB.Open connStr

Dim params As Object
Set params = JsonConverter.ParseJson(jsonParams)

Dim period  As String
Dim object_id  As String
Dim day_start  As String
Dim date_beg  As String
Dim date_end  As String
Dim data_source  As String
Dim dataseg As String
Dim day1 As String
Dim month1 As String
Dim year1 As String
Dim dt As String


dataseg = Date
ThisWorkbook.Sheets(2).Cells(1, 2).Value = dataseg
day1 = Day(dataseg)
month1 = Mid(dataseg, 4, 2)
year1 = year(dataseg)
ThisWorkbook.Sheets(2).Cells(2, 1).Value = day1
ThisWorkbook.Sheets(2).Cells(3, 1).Value = month1
ThisWorkbook.Sheets(2).Cells(4, 1).Value = year1
dt = year1 + month1 + day1
ThisWorkbook.Sheets(2).Cells(5, 1).Value = dt




period = params("period")

object_id = params("id_object")

data_source = params("datasource")

date_beg = params("date_beg")

date_end = params("date_end")

day_start = params("date")




Dim ws As Worksheet

'Set ws = Sheets("  ")

'ws.UsedRange.Clear

Dim sql As String

sql = "set nocount on EXEC spTCD__KNPZ_shipment '" + dt + "',1"
       
rc.Open sql, cnDB
ThisWorkbook.Sheets(1).Cells(1, 1).CopyFromRecordset rc
rc.Close
cnDB.Close



Dim cn1DB As New ADODB.Connection
Dim rc1 As New ADODB.Recordset
cn1DB.CommandTimeout = 360
cn1DB.Open "Provider=SQLOLEDB.1;Password=**;Persist Security Info=True;User ID=**;Initial Catalog=dbm_asrmb_knpz_20190129;Data Source=****"

Dim sql2 As String

sql2 = "Insert INTO [dbm_asrmb_knpz_20190129].[dbo].[tsd] (id_prod, prod_name, prod_okp,prod_ksm, id_transType,  transtype, id_owner, owner, m_netto, shipDT)  [COLOR=#FF0000]From rsADO"

[/COLOR]
rc1.Open sql2, cn1DB
ThisWorkbook.Sheets(3).Cells(1, 1).CopyFromRecordset rc1
rc1.Close
cn1DB.Close



В один рекордсет я записал данные. Но не могу записать из него в таблицу