http://officetanaka.net/excel/vba/tips/tips155c.htm
https://excel-ubara.com/excelvba1/EXCELVBA341.html
シナリオ: ワークブックをフィルタ選択して値のみ別ワークブックにコピーする
-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する
-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行
Option Explicit
Private Sub CommandButton1_Click()
'画面を更新しない
Application.ScreenUpdating = False
'確認メッセージを表示しない
Application.DisplayAlerts = False
'読み取り元ワークブック作成
Dim wb1 As Workbook
Set wb1 = Workbooks.Add
'テストデータ作成
With wb1.Sheets("Sheet1")
.Range("A1") = "プロジェクト名"
.Range("A2") = "PJ01"
.Range("A3") = "PJ02"
.Range("A4") = "PJ03"
.Range("B1") = "種別"
.Range("B2") = "TABLE"
.Range("B3") = "INDEX"
.Range("B4") = "VIEW"
.Range("C1") = "名前"
.Range("C2") = "=B2&""01"""
.Range("C3") = "=B3&""01"""
.Range("C4") = "=B4&""01"""
End With
'読み取り元ワークブック保存
wb1.SaveAs (ThisWorkbook.Path & "\input01.xlsx")
'読み取り元ワークブックを閉じる
wb1.Close
'読み取り元ワークブックを開く
Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\input01.xlsx")
'書き込み先ワークブック作成
Dim wb2 As Workbook
Set wb2 = Workbooks.Add
With wb1.Sheets("sheet1").Range("A1")
.AutoFilter 1, "PJ01"
.CurrentRegion.Copy wb2.Sheets("Sheet1").Range("A1")
.AutoFilter
End With
With wb2.Sheets("sheet1").Range("A1")
.CurrentRegion.Copy
.PasteSpecial Paste:=xlPasteValues
End With
'書き込み先ワークブック保存
wb2.SaveAs (ThisWorkbook.Path & "\output01.xlsx")
'書き込み先ワークブックを閉じる
wb2.Close
'読み取り元ワークブックを閉じる
wb1.Close
'確認メッセージを表示する
Application.DisplayAlerts = True
'画面を更新する
Application.ScreenUpdating = True
MsgBox ("処理完了")
End Sub