Copy Data From One WorkBook to Another workbook based on Criteria

sandy3173 · Mar 20, 2018

Hello,

I'm a newbie in Excel VBA/Macro, May I have some help please.
I have attached Sample data for easy reference.

What I want to do is to copy Data from one workbook to another workbook based on criteria.

The Criteria is to Filter All Non zero in Column Prem_1 and Copy its data in a row to another workbook.
Please see Data File as the reference of data and The Result File as the result when filtering and copying non zero value.

Hope you can assist me. Thank you in advance.

p45cal · Mar 21, 2018

Try this with a blank Result sheet:

Code:

Sub blah()
Set Destn = Workbooks("Result.xlsx").Sheets("Result").Range("A1")
Set Destn2 = Destn
Set Source = Workbooks("Data.xlsx").Sheets("Data_1").Range("A1").CurrentRegion
Set RngCriteria = Workbooks("Data.xlsx").Sheets("Data_1").Range("N25:N26")
RngCriteria.Cells(2) = "<>0"
For i = 1 To 2
  hdrs = Array("Type", "Birthday", "Issue Date", "Issue Age", "Name", "Plan", "Currency", "Price", "Value", "Prem_" & i, "Prem_Type")
  ArrayCount = UBound(hdrs) - LBound(hdrs)
  Destn2.Resize(, ArrayCount + 1) = hdrs
  RngCriteria.Cells(1) = "Prem_" & i
  Source.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RngCriteria, CopyToRange:=Destn2.Resize(, ArrayCount)    ', Unique:=False
  Destn2.Offset(, ArrayCount - 1).Value = "Prem"
  Set RngPremType = Destn.CurrentRegion.Columns(1)
  RngPremType.Offset(, ArrayCount).SpecialCells(xlCellTypeBlanks).Value = "Prem_" & i
  If i = 1 Then
    Set Destn2 = RngPremType.Cells(RngPremType.Cells.Count).Offset(1)
  Else
    Destn2.Resize(, ArrayCount + 1).Delete Shift:=xlUp
  End If
Next i
Destn.CurrentRegion.Columns("E:G").Insert
Destn.CurrentRegion.Range("E1:G1").Value = Array("Year", "Month", "Day")
RngCriteria.ClearContents
End Sub

Copy Data From One WorkBook to Another workbook based on Criteria

sandy3173

New member

Attachments

p45cal

Super Moderator