NOTE - this macro assumes that your first row of data is an header row.
Sub Extract_Data() 'Macro written by Barrie Davidson 'Variables used by the macro Dim FilterCriteria Dim CurrentFileName As String Dim NewFileName As String 'Get the current file's name CurrentFileName = ActiveWorkbook.Name 'Select the first 10 columns and first 100 rows '(note you can change this to meet your requirements) Range("A1:J100").Select 'Apply Autofilter Selection.AutoFilter 'Get the filter's criteria from the user FilterCriteria = InputBox("Enter condition to be met") 'Filter the data based on the user's input 'NOTE - this filter is on column A (field:=1), to change 'to a different column you need to change the field number Selection.AutoFilter field:=1, Criteria1:=FilterCriteria 'Select the visible cells (the filtered data) Selection.SpecialCells(xlCellTypeVisible).Select 'Copy the cells Selection.Copy 'Open a new file Workbooks.Add Template:="Workbook" 'Get this file's name NewFileName = ActiveWorkbook.Name 'Make sure you are in cell A1 Range("A1").Select 'Paste the copied cells ActiveSheet.Paste 'Clear the clipboard contents Application.CutCopyMode = False 'Go back to the original file Workbooks(CurrentFileName).Activate 'Clear the autofilter Selection.AutoFilter field:=1 'Take the Autofilter off Selection.AutoFilter 'Go to A1 Range("A1").Select End Sub
Copyright ©
2001 by Barrie R. Davidson
Added November, 2001