vba - Macro: Given row X copy specific cells from that row to a new sheet

Question

I am working on a way to generate a list based on the value of each row in a given column (G). Currently the list can copy entire rows and works perfectly. It pulls all rows if column G contains the required text ("Card") and puts them in a list on another spreadsheet with no gaps.

The problem is that I want the list to only contain information from a few columns in each row containing "Card", not the whole row.

Is there a way to make my code below pull specific cells from a row rather than using the .EntireRow function and copy the whole row?

To clarify, this spreadsheet is updated regularly by multiple different users so the information is not static. Rows are added and changed frequently and occasionally deleted. As such I cannot just copy cell values from the original sheet to the new list.

Sub AlonsoApprovedList()

  Dim cell As Range

  Dim NewRange As Range

  Dim MyCount As Long

  Dim ExistCount As Long

  ExistCount = 0

  MyCount = 1

'----For every cell in row G on the ESI Project Data sheet----'

  For Each cell In Worksheets("ESI Project Data").Range("G6:G5000")

  If cell.Value = "Card" Then

      ExistCount = ExistCount + 1

      If MyCount = 1 Then Set NewRange = cell.Offset(0, -1)

      '----Sets up a new range to copy all data from the row if column G in that row contains the value in question----'

      Set NewRange = Application.Union(NewRange, cell.EntireRow)

      MyCount = MyCount + 1

  End If

  Next cell

  If ExistCount > 0 Then

      NewRange.Copy Destination:=Worksheets("Alonso Approved List").Range("A3")

  End If

End Sub

Additional information:

1. Column G drop down data validation lists containing one several items. A complete list is in a different worksheet. Users go in to each line item and select from a specific category.

2. The other columns in question contain a line item's name, category (same as column G), a monetary value, and a date.

3. The code above loops through a list in the "ESI Project Data" Worksheet and detects rows by the value in cell G. It currently copies the whole row every time a key word is in cell G ("Card") in this example. I am using it to generate individual lists grouped by that key word. I just want it to pull individual cells, not use the .EntireRow function as it currently does. I do not know how to do that.

Thank you for your time!

Answer 1

Untested...

Sub AlonsoApprovedList()

Dim cell As Range
Dim rngDest As Range
Dim i As Long
Dim arrColsToCopy

    arrColsToCopy = Array(1, 3, 4, 5)
    '----For every cell in row G on the ESI Project Data sheet----'
    Set rngDest = Worksheets("Alonso Approved List").Range("A3")

    Application.ScreenUpdating = False

    For Each cell In Worksheets("ESI Project Data").Range("G6:G5000").Cells

        If cell.Value = "Card" Then

            For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
                With cell.EntireRow
                    .Cells(arrColsToCopy(i)).Copy rngDest.Offset(0, i)
                End With
            Next i

            Set rngDest = rngDest.Offset(1, 0) 'next destination row

        End If

    Next cell

    Application.ScreenUpdating = True

End Sub