VBA(オートフィルタ)

 

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