VBA: Copy and Paste if criteria met

[davidbuzo]

Hi all,
I have a request (Attached). It all starts with Column C on "Master"
I need to the following:
if Status (column C) = Active: put columns A:G on the "Active" tab
if Status (column C) = Terminate: put all rows on "Terminated"
if Status (column C) = Onboarding: put all rows on "onboarding

How can I use a VBA to do this?

[Leith Ross]

Hello DavidBuzo,

This macro has been added to the attached workbook. It will copy and paste the data to the proper sheets.

Sub CopyAndPasteData()
    
    Dim DstRng  As Range
    Dim DstWks  As Worksheet
    Dim Item    As Variant
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim SrcRng  As Range
    Dim SrcWks  As Worksheet
    Dim Status  As Variant
    
        Set SrcWks = ThisWorkbook.Worksheets("Master")
        
        SrcWks.AutoFilterMode = False
        
        Set RngBeg = SrcWks.Range("A1:Q1")
        Set RngEnd = SrcWks.Cells(Rows.Count, "C").End(xlUp)
        Set SrcRng = SrcWks.Range(RngBeg, RngEnd)
        
        For Each Item In Array("Active", "Onboarding", "Terminated")
            Set DstWks = ThisWorkbook.Worksheets(Item)
            Set DstRng = DstWks.Range("A2:Q2")
            
            Intersect(DstWks.UsedRange, DstWks.UsedRange.Offset(1, 0)).ClearContents
            
            SrcRng.AutoFilter Field:=3, Criteria1:=Item, VisibleDropDown:=True
            
            For Each Area In SrcRng.Areas
                Area.Copy
                DstRng.PasteSpecial Paste:=xlPasteAll
                Application.CutCopyMode = False
                Set DstRng = DstWks.Cells(1, 1)
            Next Area
        Next Item
        
        SrcWks.AutoFilterMode = False
        
End Sub

[davidbuzo]

hi Leith -
Thank you for the quick reply. It worked in your attachment, but it did not work in my version. My data is highly sensitive so I couldn't attach the full doc with real data, but the concept is the same. Where did I go wrong? Here are my steps:
I opened VBA
Insert > Module
Paste your code
Run

Here's what I get:
VBA Screenshot.jpgVBA Screenshot.jpg

Hello DavidBuzo,

This macro has been added to the attached workbook. It will copy and paste the data to the proper sheets.

Sub CopyAndPasteData()
    
    Dim DstRng  As Range
    Dim DstWks  As Worksheet
    Dim Item    As Variant
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim SrcRng  As Range
    Dim SrcWks  As Worksheet
    Dim Status  As Variant
    
        Set SrcWks = ThisWorkbook.Worksheets("Master")
        
        SrcWks.AutoFilterMode = False
        
        Set RngBeg = SrcWks.Range("A1:Q1")
        Set RngEnd = SrcWks.Cells(Rows.Count, "C").End(xlUp)
        Set SrcRng = SrcWks.Range(RngBeg, RngEnd)
        
        For Each Item In Array("Active", "Onboarding", "Terminated")
            Set DstWks = ThisWorkbook.Worksheets(Item)
            Set DstRng = DstWks.Range("A2:Q2")
            
            Intersect(DstWks.UsedRange, DstWks.UsedRange.Offset(1, 0)).ClearContents
            
            SrcRng.AutoFilter Field:=3, Criteria1:=Item, VisibleDropDown:=True
            
            For Each Area In SrcRng.Areas
                Area.Copy
                DstRng.PasteSpecial Paste:=xlPasteAll
                Application.CutCopyMode = False
                Set DstRng = DstWks.Cells(1, 1)
            Next Area
        Next Item
        
        SrcWks.AutoFilterMode = False
        
End Sub

[Leith Ross]

Hello David,

Check the names of your worksheets. The macro is looking for "Active", "Onboarding", and "Terminated". If these sheet names are missing then you will get error 91.

[davidbuzo]

These worksheets have been created. There are 8 other worksheets, does that matter? These other worksheets do not need that data.

Hello David,

Check the names of your worksheets. The macro is looking for "Active", "Onboarding", and "Terminated". If these sheet names are missing then you will get error 91.

[Leith Ross]

Hello David,

Any sheets other than "Master", "Active", "Onboarding", and "Terminated" will be ignored by the macro.

[davidbuzo]

The worksheets are properly labeled. This issue must be triggered by something else.

Hello David,

Any sheets other than "Master", "Active", "Onboarding", and "Terminated" will be ignored by the macro.

[Leith Ross]

Hello David,

Do the data sheets have header rows? If not then the Intersect method will fail because there are no cells with data in them.

[p45cal]

A variant approach using Advanced Filter. The attached has the 3 destination sheets preloaded with headers on row 1 (The code can do this instead if you want if they are completely blank sheets).
The headers don't need to be the same on each sheet; for example I've missed out the Status column on Terminated sheet because that column, by definition, will have only 'Terminated' in it, so it's not much use there. The same applies to all sheets really. I've also missed out the Termination date on all but the Terminated sheet. You can have as many or as few headers on each sheet as you want as long as they are a subset of the headers on the Master sheet.
This works because the sheet names are exactly the same as the various entries in the Status column, so if you had more sheets you'd only have to change the line:
For Each Status In Array("Active", "Terminated", "Onboarding")
to include more sheet names.
The button in the vicinity of cell S3 on the Master sheet of the attached runs this code:

Sub blah()
With Sheets("Master")
  Set RangeSource = Intersect(.Range("A1").CurrentRegion, .Columns("A:Q"))
  .Range("AA1").Value = "Status"
  For Each Status In Array("Active", "Terminated", "Onboarding")
    .Range("AA2").Value = Status
    RangeSource.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("AA1:AA2"), CopyToRange:=Sheets(Status).Range("A1", Sheets(Status).Cells(1, Columns.Count).End(xlToLeft)), Unique:=False
  Next
  .Range("AA1:AA2").Clear
End With
End Sub