PDA

View Full Version : VBA: Copy and Paste if criteria met



davidbuzo
07-26-2019, 10:26 AM
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
07-26-2019, 01:59 PM
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
07-29-2019, 04:54 AM
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:
2469924699


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
07-29-2019, 08:29 AM
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
07-29-2019, 08:44 AM
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
07-29-2019, 09:58 AM
Hello David,

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

davidbuzo
07-29-2019, 10:46 AM
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
07-29-2019, 11:15 PM
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
07-30-2019, 05:47 AM
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