テーブル内容を新規エクセルシートへ転記

抽出結果を新規エクセルシートへ転記

Sub 抽出結果を新規エクセルシートへ転記()
Dim myCon As New ADODB.Connection
Dim DataBook As String, ReportBook As String
Dim myTbl As String, myNewSht As String, tmpStr As String

'接続先のファイル、、転記先エクセルファイル、取込元テーブル、取込先シートを指定
DataBook = ThisWorkbook.Path & "\mdb\2-sampleDB.mdb"
ReportBook = ThisWorkbook.Path & "\xls\4-19_2 Accessのデータを抽出して書き出す.xls"
myTbl = "伝票一覧 WHERE 得意先='小料理ひろ';"
myNewSht = "抽出した伝票一覧テーブル"

'書き込み文字列を作成
tmpStr = "[Excel 8.0;DATABASE=" & ReportBook & "].[" & myNewSht & "]"

With myCon
  .Provider = "Microsoft.Jet.OLEDB.4.0"
  .Open DataBook
  .Execute "SELECT * INTO " & tmpStr & " FROM " & myTbl
End With

myCon.Close: Set myCon = Nothing

End Sub

実行結果