Results 1 to 2 of 2

Thread: Copy Data From One WorkBook to Another workbook based on Criteria

  1. #1

    Red face Copy Data From One WorkBook to Another workbook based on Criteria



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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.
    Attached Files Attached Files

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,742
    Articles
    0
    Excel Version
    365
    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
    Last edited by p45cal; 2018-03-22 at 12:07 AM.

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
  •