Consulting

Results 1 to 3 of 3

Thread: Copy data based on a certain criteria

  1. #1
    VBAX Newbie
    Joined
    Aug 2019
    Posts
    2
    Location

    Copy data based on a certain criteria

    Hello,

    I am trying to create a risk evaluation work-flow in Excel using VBA but I am very new to this and would like some help from you pros on this site.

    The work-flow is as follows:
    1. Open Excel
    2. On first Worksheet choose an option (checkboxes - "Security","Quality","Environment" etc. - with combinations as well)
    3. On the second Worksheet a list of risks has been generated based on the previous options that were chosen
    (It is generated from a seperate workbook based on the criteria "yes". For example: Column A2 = "yes" - then all the cells on that row should be copied).

    So far I have been able to copy a range based on a critera. Although it only work if I'm placed in the Worksheet "Risk database" I am copying from when I am running my sub. Here is my current code:

    Sub Copy()
    
    Application.ScreenUpdating = False
    
    Worksheets("Sheet2").UsedRange.Offset(1).ClearContents
    
    With Worksheets("Risk database")
        .AutoFilterMode = False
        With Range("A1", Range("A" & Rows.Count).End(xlUp))
            .AutoFilter 1, "yes"
            On Error Resume Next
            .Offset(1).EntireRow.Copy
            Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End With
        .AutoFilterMode = False
    End With
    
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Worksheets("Sheet2").Select
    
    End Sub
    (I am using Excel 2016 on the latest Windows software. )

    Thank you for your help

  2. #2
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi, Cribbza!
    "Copy" is a system reserved word. It's better not to use it as a process name.
    Sub Copy_1()
    Application.ScreenUpdating = False
    Worksheets("Sheet2").UsedRange.Offset(1).ClearContents
    With Worksheets("Risk database")
        .AutoFilterMode = False
        With .Range("A1", .Range("A" & Rows.Count).End(xlUp))  '-->edited
            .AutoFilter 1, "yes"
            On Error Resume Next
            .Offset(1).EntireRow.Copy
            Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End With
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Worksheets("Sheet2").Select
    End Sub

  3. #3
    VBAX Newbie
    Joined
    Aug 2019
    Posts
    2
    Location
    Thanks for the help, the code works now!

    Have a great day!








Tags for this Thread

Posting Permissions

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