宏:给定第X行，将该行中的特定单元格复制到新工作表中 [英] Macro: Given row X copy specific cells from that row to a new sheet

问题描述

我正在研究一种基于给定列(G)中每一行的值生成列表的方法.当前，该列表可以复制整个行，并且可以完美运行.如果G列包含必需的文本(卡片")，它将拉出所有行，并将它们放在另一个电子表格的列表中，且没有任何空格.

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.

是否有办法使我的代码从一行中提取特定的单元格，而不是使用.EntireRow函数并复制整行?

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

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

其他信息:

1. G列下拉数据验证列表，其中包含几个项目.完整列表在其他工作表中.用户进入每个订单项，然后从特定类别中进行选择.

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.

有问题的其他列包含订单项的名称，类别(与G列相同)，货币值和日期.

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

以上代码循环遍历"ESI项目数据"工作表中的列表，并按单元格G中的值检测行.当前，每次关键字在单元格G中时，整个行都会复制整行(卡").我正在使用它来生成按该关键字分组的单个列表.我只希望它拉单个单元格，而不是像现在那样使用.EntireRow函数.我不知道该怎么做.

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.

谢谢您的时间！

推荐答案

未经测试...

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

这篇关于宏:给定第X行，将该行中的特定单元格复制到新工作表中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！