Results 1 to 6 of 6

Conditional Copying

Threaded View

  1. #1
    Registered User
    Join Date
    02-15-2010
    Location
    Bournemouth
    MS-Off Ver
    Excel 2003
    Posts
    76

    Conditional Copying

    A Happy 20011 to one and all.

    I was wondering if someone could assist me? I have cheekily copied someone's code to achieve what I want, however it doesn't quite do what I require. Basically I have a spreadsheet which I want only those rows which fall under a certain condition to be copied into a new sheet. For example if I have data populated in columns A, B & C, where C contains number reanging from 1 to 10; I would like to copy all data where the number in column C ranges from 3 and above. The code below copies everything that I need but I have to specify the number I want displayed. Is there a way (for example) I can amend the code to select all numbers greater than 3 and above? currently the code will display only those rows where column C is equal to 0?

    I have attached my test spreadsheet for ease of understanding.

    Apologies for any confision and thank you all in advance.

    Cheers
    Ivor

    Sub Extract_Data_Two()
    Application.ScreenUpdating = False
    Dim FilterCriteria
    Dim CurrentsheetName As String
    Dim NewFileName As String
    'Get the current sheets's name
    CurrentsheetName = ActiveSheet.Name
    'Select the range
    '(note you can change this to meet your requirements)
    Range("A1:C27").Select
    'Apply Autofilter
    Selection.AutoFilter
    'Get the filter's criteria from the user
    FilterCriteria = 2
    'Filter the data based on the user's input
    'NOTE - this filter is on column N (field:=14), to change
    'to a different column you need to change the field number
    Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
    'Select the visible cells (the filtered data)
    Selection.SpecialCells(xlCellTypeVisible).Select
    'Copy the cells
    Selection.Copy
    Sheets.Add
    'Make sure you are in cell A1
    Range("A1").Select
    'Paste the copied cells
    ActiveSheet.Paste
    'Clear the clipboard contents
    Application.CutCopyMode = False
    ' Auto fits text in Columns
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select
    'Go back to the original sheet
    Worksheets(CurrentsheetName).Activate
    'Clear the autofilter
    Selection.AutoFilter field:=1
    'Take the Autofilter off
    Selection.AutoFilter
    'Go to A1
    Range("A1").Select
    Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files
    Last edited by Ivor; 01-09-2011 at 06:03 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1