基於另一個範圍的行號將值添加到範圍

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