SQLでデータ転記

Option Explicit
Sub 全て表示()

    '画面更新・再計算・イベントの停止
    Dim speedObj As SpeedUp
    Set speedObj = New SpeedUp

    'ADOインスタンス生成
    Dim cn As New ADODB.Connection
'
        
    'ADO接続設定(Excelを開く設定)
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"                'Exel2007以降の設定
        .Properties("Extended Properties") = "Excel 12.0;HDR=Yes"
        .Open ThisWorkbook.Path & "\" & "天草.xlsx"      '開くブックのパス(フルパス)
    End With
    
'    Call clearTable

    '***転記開始***
    
    '貼り付け先の設定
    Dim startRow As Long
    If Range("A12") = "" Then
        startRow = 12
    Else
        startRow = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End If
    
    'レコードセットの取得
    Dim rs As New ADODB.Recordset
    With rs
        '県事例番号
        .Open "SELECT 県事例番号 FROM [Sheet1$D18:K]", cn, adOpenStatic   'テーブルの場所を指定する場合
        Range("A" & startRow).CopyFromRecordset rs
        Dim num As Long
        num = .RecordCount 'レコード数
        .Close
        
        
        '氏名・・・
        .Open "SELECT 氏名,ふりがな,電話番号1,電話番号2 FROM [Sheet1$D18:K]", cn
        Range("E" & startRow).CopyFromRecordset rs
        .Close
        
        
        '特記事項
        .Open "SELECT * FROM [Sheet1$I18:I]", cn
        Range("K" & startRow).CopyFromRecordset rs
        .Close
    
    End With
    
    'メモリの解放
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Set speedObj = Nothing
    
    '電話番号の修正
'    Call phoneConv3
    
End Sub

Sub clearTable()
    Range("A12:M" & Rows.Count).ClearContents

End Sub