Copy & Paste Based on Column Criteria

[zljordan]

Hi All,

I am in need of some help formulating a macro that will allow me to copy data from one sheet to another based upon the a specific criteria. Basically, I have a workbook with the sheets "CopyFrom" and "CopyTo". On the sheet "CopyFrom", I have my data organized the following columns:

A ----> "Ticker"
B ----> "Description"
C ----> "Asset Class"
D ----> "Manager Style"

On the sheet "CopyTo" I have filtered and transposed all of the individual manager styles found in Column D on the "CopyFrom" worksheet. From here I would like to copy all of the ticker symbols ("CopyFrom" ColA) that correspond to the criteria (Manager Style) set fourth in R1 of the "CopyTo" worksheet.

I have attached a sample workbook with an example of how I would like the end result to turn out.

Thank you in advance for your help. It is greatly appreciated.

[p45cal]

Try placing the following in your example file; it creates a new sheet each time and populates it:

Sub blah()
Set SourceSht = Sheets("CopyFrom")
SourceLr = SourceSht.UsedRange.Rows.Count
'create new sheet and set up headers:
With Sheets.Add(After:=Sheets(Sheets.Count))
  SourceSht.Range("D1:D" & SourceLr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"), Unique:=True
  NewShtLr = .UsedRange.Rows.Count
  .Range("A2:A" & NewShtLr).Copy
  .Range("B1").PasteSpecial Transpose:=True
  .Columns(1).ClearContents
  'populate columns in the new sheet:
  For Each cll In .Range("B1").Resize(, NewShtLr - 1).Cells
    SourceSht.Range("A1").AutoFilter Field:=4, Criteria1:=cll.Value
    SourceSht.Range("A2:A" & SourceLr).Copy cll.Offset(1)
  Next cll
End With
SourceSht.Range("B1").AutoFilter
End Sub

[zljordan]

This worked incredibly! Thank you very much for your help!!