Sub 絞り込みデータコピー()
Dim Mybook As Workbook
Dim Newbook As Workbook

Set Mybook = ThisWorkbook
 With Mybook.ActiveSheet
   If .FilterMode = True Then 'フィルターがある場合
    .ShowAllData '全部開く
   End If
  .Range("A1").CurrentRegion.AutoFilter Field:=.Range("AZ1").Column, _
  Criteria1:="<>完了"'AZ1が完了じゃないものを絞り込み!
 End With

Set Newbook = Workbooks.Add '新しいブックを作成!
 Application.DisplayAlerts = False '警告ポップアップを出なくする
  Newbook.Worksheets("Sheet2").Delete  'Sheet2を削除
  Newbook.Worksheets("Sheet3").Delete  'Sheet3を削除
 Application.DisplayAlerts = True '警告ポップアップを出るようにする

  Mybook.ActiveSheet.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
  Newbook.Worksheets("Sheet1").Range("A1")
  Newbook.Worksheets("Sheet1").Columns.AutoFit '列幅を自動調整
  Newbook.Worksheets("Sheet1").Rows.RowHeight = 15 '行の高さを15に設定
  Newbook.Worksheets("Sheet1").Range("H3").Select 'H3を選択
  ActiveWindow.FreezePanes = True 'ウィンドウ枠の固定
  
   Mybook.ActiveSheet.Range("A1").CurrentRegion.AutoFilter Field:=Mybook.ActiveSheet.Range("AZ1").Column’新しいブックにフィルターをつける

Newbook.SaveAs Filename:="C:\Users\TESTUSER\Desktop\絞り込みデータ" & Format(date, "yyyymmdd") & ".xls"
 'ファイル名をTESTUSERのDesktopに絞り込みデータ20150520.xls などとして保存
Newbook.Close'閉じる
  
End Sub

前へ 次へ

この情報が含まれているまとめはこちら

【VBA】 オートフィルターでの抽出作業【Excel】

オートフィルターでの可視セルのコピーや、絞り込みです。可視セルのみコピーしたい場合や、可視セルのみ数式をコピーしたい場合など様々な場合で使いたいことは多いでしょう!ということでまとめます。(取り急ぎ。 追記予定)

このまとめを見る