基于另一个范围的行号将值添加到范围

Question

我正在根据给定列（G）中每行的值生成列表。目前该列表可以复制整行并完美地工作。如果列G包含所需文本（“卡片”），并将它们放在另一个电子表格的列表中，并且没有空白，它将拉取所有行。

问题是我希望列表只包含每行包含“卡”的几列中的信息，而不是整行。

有没有办法让我的宏只能从列“A”，“G”和“ET”拉动信息？

我目前正在使用的代码如下：

'----Alonso Approved List Generator----' 
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 

因此，在短期我想修改上面的代码从一个工作表中获取数据，然后生成一个列表，另一个给来自行号“单元格“范围和特定列。

卡按揭汽车零售商业投资顾问集合操作的信息技术社区事务的人力资源市场房产行政财务风险信用采购人员等管理RCC

：包含以下项目之一

G列下拉数据验证列表

这可能吗？

如果我可以使用类似匹配函数的东西来确定标题使用的列，那将是非常好的。

为了澄清，此电子表格由多个不同的用户定期更新，因此信息不是静态的。行添加和更改频繁并偶尔删除。因此，我不能将单元格值从原始工作表复制到新列表中。

问题的回答：

1. G列下拉一个包含若干项数据验证列表。完整列表位于不同的工作表中。用户访问每个订单项并从特定类别中进行选择。
2. 有问题的其他列包含订单项的名称，类别（与G列相同），货币值和日期。
3. 我很犹豫是否上传数据，因为它大部分是公司信息。我的目标是让一个宏自动将多个单元格从同一行复制到另一个表单。循环和检测正确的行已经在那里。基本上，有没有办法用该单元格中的几个选择行替换“cell.EntireRow”（复制整行）？

Answer 1

我想回来更新这个问题并给出答案。它有点延迟，但回答的问题比永久性开放的问题要好...

Sub ApprovedList() 

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