VBA to copypaste certain parts of rows based on multiple criteria

[kwt890]

Hi all,

Basically I'm trying to take information from a massive spread and based off of three colomns of criteria have the information in all rows that meets that be copied over to an existing sheet. However, I do not want all the information in each row from the master sheet to go into the other sheet, but just a few particular columns. Hope this makes sense. I have attached the code I wrote that isn't working =/ Your help is greatly appreciated!

Sub Geco()
  Dim i, Y, x As Long
  Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Master Audit-IR")
  Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet1")
  Dim r1, r2, r3, r4, r5, r6, MultipleRange1 As Range
  Dim d1, d2, d3, d4, d5, d6, MultipleRange2 As Range
  
  
  
   x = 3
   Y = "GECO"
        
   For i = 7 To 2000:
         If ws1.Cells(i, 1) = Y Then
            ws1.Activate
            Set r1 = Cells(i, 3)
            Set r2 = Cells(i, 5)
            Set r3 = Cells(i, 8)
            Set r4 = Cells(i, 11)
            Set r5 = Cells(i, 12)
            Set r6 = Cells(i, 14)
           Set MultipleRange1 = Union(r1, r2, r3, r4, r5, r6)
            ws2.Activate
            Set d1 = Cells(x, 1)
            Set d2 = Cells(x, 4)
            Set d5 = Cells(x, 5)
            Set d4 = Cells(x, 6)
            Set d3 = Cells(x, 7)
            Set d6 = Cells(x, 8)
            Set MultipleRange2 = Union(d1, d2, d3, d4, d5, d6)
            MultipleRange2.Value = MultipleRange1.Value
            
            x = x + 1
         End If
   Next i
End Sub

 

[JLGWhiz]

Try replacing this:

For i = 7 To 2000:
         If ws1.Cells(i, 1) = Y Then
            ws1.Activate
            Set r1 = Cells(i, 3)
            Set r2 = Cells(i, 5)
            Set r3 = Cells(i, 8)
            Set r4 = Cells(i, 11)
            Set r5 = Cells(i, 12)
            Set r6 = Cells(i, 14)
           Set MultipleRange1 = Union(r1, r2, r3, r4, r5, r6)
            ws2.Activate
            Set d1 = Cells(x, 1)
            Set d2 = Cells(x, 4)
            Set d5 = Cells(x, 5)
            Set d4 = Cells(x, 6)
            Set d3 = Cells(x, 7)
            Set d6 = Cells(x, 8)
            Set MultipleRange2 = Union(d1, d2, d3, d4, d5, d6)
            MultipleRange2.Value = MultipleRange1.Value
            
            x = x + 1
         End If
   Next i

With this

Dim sAry As Variant, tAry As Variant, i As Long 'move this line to the top of your code with the other declarations.
ws1.Range("A6", ws1.Cells(Rows.Count, 14).End(xlUp)).AutoFilter 1, "Y"
sAry = Array(3, 5, 8, 11, 12, 14)
tAry = Array(1, 4, 5, 6, 7, 8)
    For i = LBound(tAry) To UBound(tAry)
        ws1.Range(ws1.Cells(7, sAry(i)), ws1.Cells(Rows.Count, sAry(i)).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        ws2.Cells(Rows.Count, tAry(i)).End(xlUp)(2)
    Next

 

[kwt890]

Thanks JLGWhiz for your help, but i'm afraid i'm so new to VBA i'm lost to getting your code to work in conjunction with mine. Basically, I want to search my master sheet for anything that is "aaa" and also "bbb" and "ccc" then put only the specific information from columns i named above to the other sheet in columns 1, 4, 5, 6, 7, 8. Then search run again in master sheet for "aaa" and also "ddd" and "eee" again the specific columns and pasting into the sheet in the same columns but maybe 10 rows down. And continue another "next" where it again searchs in master sheet anything that is "aaa" but "fff" and "ggg" etc for two or three more times always putting into the same columns in the new sheet but seperated by 10 rows or something. I just can't figure it out. Like at all.