宏：给定行 X 将特定单元格从该行复制到新工作表

Question

我正在研究一种基于给定列 (G) 中每一行的值生成列表的方法。目前该列表可以复制整行并完美运行。如果 G 列包含所需的文本（“卡片”），它会拉出所有行，并将它们放在另一个电子表格的列表中，没有间隙。

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

有没有办法让下面的代码从一行中提取特定单元格，而不是使用 .EntireRow 函数并复制整行？

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

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 列下拉数据验证列表包含一个几个 项目。完整列表位于不同的工作表中。用户进入 每个订单项并从特定类别中进行选择。

2. 有问题的其他列包含订单项的名称、类别 （与 G 列相同）、货币价值和日期。

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

感谢您的宝贵时间！

Answer 1

未经测试...

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

Answer 2

您好，我可以使用一个代码通过单击按钮将特定单元格复制到另一个工作簿。

这就是我想要做的，

从工作簿 1 我需要从以下单元格中复制信息 我有关于单元格 A40 到 A69 的 B 列信息 我有关于单元格 b2、b3、b4、b8、9、10、11、12、13、14、15 和 b40 到 b69 的 B 列信息 我有关于单元格 b2 的 D 列信息， 我有关于单元格 b1、b2、b3、b4 的 G 列信息

我需要将所有这些都发送到 workbook2，它具有分配给此特定信息的相同单元格。

希望我说清楚了。