Copy\Paste multiple criteria based rows to new sheet

Hi All,

I need to copy specific rows that have a specific value in colum B and Colum M to new worksheets.

So from attached screenshot , say for an example macro shud filter rows that have "BigPond" in coloum B ,"RG2" in column M & "INT" in column W and i dont want all cells in these rows , i only want copy cells under column C,AK,AL,AM (in this order) to my other excel sheet that is named "BigPond" and it should paste it starting from Row5. ??

I want to avoid recording a macro as it selects a range and i am expecting more new rows every week so if a record a macro the cell range for selection changes and i get incorrect result.

Any HELP , ADVICE or a code for this ..plzzzz??

See the attached screenshot to see my main worksheet from where all this data is coming from...

Thnkz.

HI

Can you please attach a sample workbook rather than a gif. If the columns all have headings, it may be possible to use an advanced filter to do this.


rylo

Originally Posted by rylo

HI

Can you please attach a sample workbook rather than a gif. If the columns all have headings, it may be possible to use an advanced filter to do this.


rylo

Okies..Sample worksheet attached hereby.
Thats where data is coming from ..

thnkz.

Hi

This assumes that you have an existing sheet called BigPond. Part of the process will delete any existing data on this sheet.

Nothing will be copied across from your sample sheet as you don't have an entry in column M with the data RG2.

rylo

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("BigPond")
  OutSH.Cells.ClearContents
  
  'So from attached screenshot , say for an example macro shud filter rows that have
  '"BigPond" in coloum B ,"RG2" in column M & "INT" in column W and
  'i only want copy cells under column C,AK,AL,AM (in this order)
  'to my other excel sheet that is named "BigPond" and it should paste it starting from Row5. ??
  Sheets("Sites Data").Activate
  Range("A1").Select
  
  OutSH.Range("A1:C1").Value = Array("BU", "RG2", "Ext / Int")
  OutSH.Range("A2:C2").Value = Array("BigPond", "RG2", "INT")
  
  OutSH.Range("A4:D4").Value = Array("Prefered Name", "RG2 Apps Shakeout - Verify users can login successfully", "RG2 Apps Shakeout - Verify users have correct roles", "RG2 Apps Shakeout - Tester's Siebel login ID")
  Range("A1").CurrentRegion.AdvancedFilter action:=xlFilterCopy, criteriarange:=OutSH.Range("A1:C2"), copytorange:=OutSH.Range("A4:D4")
  
  
End Sub

Hi

See how this goes. There is some formatting that hasn't been done, but I'm after the data extract and formula correctness.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("BigPond")
  OutSH.Cells.ClearContents
  
  'So from attached screenshot , say for an example macro shud filter rows that have
  '"BigPond" in coloum B ,"RG2" in column M & "INT" in column W and
  'i only want copy cells under column C,AK,AL,AM (in this order)
  'to my other excel sheet that is named "BigPond" and it should paste it starting from Row5. ??
  Sheets("Sites Data").Activate
  Range("A1").Select
  
  OutSH.Range("A1:C1").Value = Array("BU", "RG2", "Ext / Int")
  OutSH.Range("A2:C2").Value = Array("BigPond", ">0", "INT")
  
  OutSH.Range("A4:E4").Value = Array("Prefered Name", "RG2 Apps Shakeout - Verify App Deployment is complete", "RG2 Apps Shakeout - Verify users can login successfully", "RG2 Apps Shakeout - Verify users have correct roles", "Ext / Int")
  Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, criteriarange:=OutSH.Range("A1:B2"), copytorange:=OutSH.Range("A4:E4")
  
  With OutSH
    .Range("A4:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort order1:=xlDescending, key1:=.Range("E4"), header:=xlYes
    i = 5
    While .Cells(i, "E").Value = "INT"
      i = i + 1
    Wend
    breakrow = i
    .Cells(breakrow, "A").Resize(5, 1).EntireRow.Insert shift:=xlDown
    .Cells(breakrow, "A").Value = "INT Ttoal"
    .Cells(breakrow, "B").Formula = "=SUM(B5:B" & breakrow - 1 & ")/COUNTA($A5:$A" & breakrow - 1 & ")"
    .Cells(breakrow, "B").AutoFill Destination:=.Range(.Cells(breakrow, "B"), .Cells(breakrow, "E"))
    .Range("E4").Value = "Overall"
    .Range("E5").Formula = "=SUM(B5:D5)/3"
    .Range("D5").Copy
    .Range("E5").PasteSpecial (xlPasteFormats)
    .Range("E5").AutoFill Destination:=.Range("E5:E" & breakrow - 1)
    
    'formulas for EXT
    breakrow = breakrow + 5
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(lastrow + 1, "A").Value = "EXT Total"
    .Cells(lastrow + 1, "B").Formula = "=sum(B" & breakrow & ":B" & lastrow & ")/counta($A" & breakrow & ":$A" & lastrow & ")"
    .Range("B" & lastrow + 1).Copy Destination:=.Range("B" & lastrow + 1 & ":E" & lastrow + 1)
    .Range("E5").Copy Destination:=.Range("E" & breakrow)
    .Range("E" & breakrow).AutoFill Destination:=.Range("E" & breakrow & ":E" & lastrow)
    lastrow = lastrow + 2
    .Range("A" & lastrow).Value = "Grand Total"
    
    intlastrow = .Range("A4").End(xlDown).Row - 1
    .Range("B" & lastrow).Formula = "=sum(B5:B" & intlastrow & ",B" & breakrow & ":B" & lastrow - 2 & ")/counta($A5:$A" & intlastrow & ",$A" & breakrow & ":$A" & lastrow - 2 & ")"
    .Range("B" & lastrow).AutoFill Destination:=.Range("B" & lastrow & ":E" & lastrow)
    
    .Range("B4:D4").Replace what:="RG2 Apps Shakeout - ", replacement:=""
  End With
End Sub

rylo