カード型データベースを作ってみよう

'一覧ボタン
Private Sub CommandButton3_Click()
    Dim App As Object
    Dim push As Integer
    Dim twb As Workbook

    '新規シート作成枚数をプッシュ
    push = Application.SheetsInNewWorkbook

    'Excelを起動
    Set App = CreateObject("Excel.Application")
    '表示する
    App.Visible = True
    
    'シートを1枚作成
    Application.SheetsInNewWorkbook = 1
    'ブックを追加する
    Set twb = App.Workbooks.Add
    
    '3列をコピーする
    Workbooks("Data.xls").Worksheets("Sheet1").Range("A:C").Copy   ' Destination:=Workbooks("c:\t0.xls").Worksheets("Sheet1").Cells
    '貼り付け
    App.Worksheets("Sheet1").Paste
    '列幅をコピー
App.Worksheets("Sheet1").Cells(1, 1).ColumnWidth = _
Workbooks("Data.xls").Worksheets("Sheet1").Cells(1, 1).ColumnWidth
App.Worksheets("Sheet1").Cells(1, 2).ColumnWidth = _
Workbooks("Data.xls").Worksheets("Sheet1").Cells(1, 2).ColumnWidth
App.Worksheets("Sheet1").Cells(1, 3).ColumnWidth = _
Workbooks("Data.xls").Worksheets("Sheet1").Cells(1, 3).ColumnWidth
    'コピー先のシート名を変更
    twb.Worksheets("Sheet1").Name = "DB一覧"
    
    '戻す
    Application.SheetsInNewWorkbook = push

End Sub