Copy rows to new worksheet on condition
Eliminate Pivot Table Annoyances
Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 18

Thread: Copy rows to new worksheet on condition

  1. #1
    New Member
    Join Date
    Mar 2002
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    Dear Excelsperts,

    I haven't mucked about with Excel in quite a while now and have been asked to do a module in Excel 2000.

    When given a workbook (tej-exit.xls) which has one worksheet of thousands of rows with columns from A to AS, i would like to copy all rows which have a zero in column N to a new worksheet.

    Is this difficult?
    Would i have to have one workbook with the code module in, load up the tej-exit.xls file ?

    Thanks for any help

    IanMc

  2. #2
    Board Regular
    Join Date
    Feb 2002
    Location
    Georgia USA
    Posts
    569
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Try this
    This Marco was modified to fit your needs, from one written by Barrie Davidson, you will need to change the range to fit, right now it is looking at Range("A1:AS3000"). Put this in a module in your workbook (tej-exit.xls). As always, make a backup before trying anything new
    HTH
    Sub Extract_Data()
    'this macro assumes that your first row of data is a header row.
    'will copy a row from one worksheet, to another blank workbook
    'IF there is a 0 in column N
    'Variables used by the macro
    Application.ScreenUpdating = False
    Dim FilterCriteria
    Dim CurrentFileName As String
    Dim NewFileName As String

    'Get the current file's name
    CurrentFileName = ActiveWorkbook.Name
    'Select Range
    '(note you can change this to meet your requirements)
    Range("A1:AS3000").Select
    'Apply Autofilter
    Selection.AutoFilter
    FilterCriteria = 0
    '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:=14, 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
    Application.ScreenUpdating = True
    End Sub



  3. #3
    New Member
    Join Date
    Mar 2002
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Thanks Paul B !!!

    I'll give it a whirl and let you know how i get on.

    Is it also possible to have it in another blank workbook like 'code.xls' and then to 'import' the worksheet from the original?

    Is it possible to get 'it' to do the importing?

    Thanks muchly for your swift and knowledgeable help

    IanMc

  4. #4
    Board Regular
    Join Date
    Feb 2002
    Location
    Georgia USA
    Posts
    569
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    you can put it your personal.xls workbook and it will be available in all workbooks

  5. #5
    New Member
    Join Date
    Mar 2002
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Thanks again Paul,

    What if i just want to add another worksheet with the results?

    I've tried this so far:

    Sub Extract_Data()
    'this macro assumes that your first row of data is a header row.
    'will copy a row from one worksheet, to another blank workbook
    'IF there is a 0 in column N
    'Variables used by the macro
    Application.ScreenUpdating = False
    Dim FilterCriteria
    Dim CurrentFileName As String
    Dim NewFileName As String
    'Dim FirstSheet As Long

    'FirstSheet = Sheets(ActiveWorkSheet)
    'Get the current file's name
    CurrentFileName = ActiveWorkbook.Name
    'Select Range
    '(note you can change this to meet your requirements)
    Range("A1:AS3000").Select

    'Apply Autofilter
    Selection.AutoFilter
    FilterCriteria = 0
    '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:=14, Criteria1:=FilterCriteria
    'Select the visible cells (the filtered data)
    Selection.SpecialCells(xlCellTypeVisible).Select
    'Copy the cells
    Selection.Copy

    'Clear the autofilter
    '
    Selection.AutoFilter field:=1
    'Take the Autofilter off
    Selection.AutoFilter

    'Open a new worksheet 'file
    Sheets.Add().Name = "Results"
    Sheets("Results").Paste
    'Get this file's name
    'NewFileName = ActiveWorkbook.Name
    'Make sure you are in cell A1
    'ActiveSheet = "Results"
    'Range("A1").Select
    'Paste the copied cells
    'ActiveSheet.Paste

    'Go back to the original file
    'Sheets(FirstSheet).Select

    'Workbooks(CurrentFileName).Activate


    'Clear the clipboard contents
    Application.CutCopyMode = False
    'Go to A1
    Range("A1").Select
    Application.ScreenUpdating = True
    'Now make a worksheet with everything that is NOT zero in column N


    UserForm1.Hide
    End
    End Sub


    But it fails to paste the data,,, i don't have the VBA help files installed for my Excel yet (i've put in a request) so i'm a bit lost.

    Thanks

    Ian

  6. #6
    Board Regular
    Join Date
    Feb 2002
    Location
    Georgia USA
    Posts
    569
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    'this will put your data in a new worksheet
    'it will also Auto fits text in Columns on the new sheet
    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:AS3000").Select
    'Apply Autofilter
    Selection.AutoFilter
    'Get the filter's criteria from the user
    FilterCriteria = 0
    '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:=14, 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


  7. #7
    New Member
    Join Date
    Mar 2002
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Thanks Paul !! i shall give that a try,
    Meanwhile thanks to your help i've managed to get it exactly as required in this instance.

    The final subroutine (below) does the job.
    The routine is activated by a button on the toolbar, (well actually this activates a nicely drawn UserForm with a picture, label and button on it, the button actually activates the subroutine)
    The user first loads this Excel program with this in it and assigns a toolbar button to open the UserForm macro.

    They then choose 'Open' and open the tej-exit.xls data file,
    when the file opens all of the data apart from cell A1 is selected but this doesn't seem to matter,,, when they click on the toolbar button (which is a smiley) the UserForm opens and tells them what to do, they click on the button and the working is:
    All rown with column N = zero are highlighted on the worksheet called tej-exit plus there has appeared a new worksheet called 'Results' which has only the rows in it with column N = zero
    (it doesn't need for the first row to be headers or anything as it turns the filter back off)

    The subroutine is here below, thank you very much indeed for your excellent help and i shall have a play with your latest version.

    IanMc


    Sub Extract_Data()
    'this macro assumes that your first row of data is a header row.
    'will copy a row from one worksheet, to another blank workbook
    'IF there is a 0 in column N
    'Variables used by the macro
    Application.ScreenUpdating = False
    Dim FilterCriteria
    Dim CurrentFileName As String
    Dim NewFileName As String

    Set a = ActiveSheet
    'Select Range
    '(note you can change this to meet your requirements)
    Range("A1:AS4000").Select
    'Apply Autofilter
    Selection.AutoFilter
    FilterCriteria = 0
    '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:=14, 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
    Sheets.Add().Name = "Results"
    Set b = ActiveSheet
    'Make sure you are in cell A1
    Range("A1").Select
    'Paste the copied cells
    ActiveSheet.Paste
    Range("A1").Select 'unselect everything
    'Clear the clipboard contents
    Application.CutCopyMode = False
    'Go back to the original file
    'Workbooks(CurrentFileName).Activate
    a.Select
    Selection.AutoFilter field:=14, Criteria1:=FilterCriteria
    Selection.SpecialCells(xlCellTypeVisible).Select
    'Clear the autofilter
    'Selection.AutoFilter field:=1
    'Take the Autofilter off
    Selection.AutoFilter
    'Go to A1
    'Range("A1").Select
    Application.ScreenUpdating = True
    End
    End Sub

  8. #8
    Board Regular
    Join Date
    Nov 2008
    Location
    Seattle, WA
    Posts
    246
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy rows to new worksheet on condition

    When I run this it only copies the header row into a newly created results worksheet?

    Once I get this working it is exactly what I was looking for...

  9. #9
    Board Regular
    Join Date
    Nov 2008
    Location
    Seattle, WA
    Posts
    246
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy rows to new worksheet on condition

    Got it working

  10. #10
    Board Regular sadi's Avatar
    Join Date
    Jun 2009
    Posts
    93
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy rows to new worksheet on condition

      
    Thanks Paul,
    but how can i protect my work book with morethan 5 sheet form another user. I can't run macro in protected workbook.

    BR
    sadi

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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

 

 
DMCA.com