vba 宏：给定 X 行将特定单元格从该行复制到新工作表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14693566/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Macro: Given row X copy specific cells from that row to a new sheet
提问by TMF
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.
我正在研究一种基于给定列 (G) 中每一行的值生成列表的方法。目前该列表可以复制整行并且完美运行。如果 G 列包含所需的文本（“卡片”），它会拉出所有行，并将它们放在另一个电子表格上的列表中，没有间隙。
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?
有没有办法让我下面的代码从一行中提取特定的单元格，而不是使用 .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
Additional information:
附加信息：
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.
The other columns in question contain a line item's name, category (same as column G), a monetary value, and a date.
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.
G 列下拉数据验证列表包含一个多个项目。完整列表位于不同的工作表中。用户进入每个行项目并从特定类别中进行选择。
其他相关列包含行项目的名称、类别（与 G 列相同）、货币值和日期。
上面的代码循环遍历“ESI 项目数据”工作表中的列表，并通过单元格 G 中的值检测行。在此示例中，它当前每次在单元格 G（“卡片”）中出现关键字时都会复制整行。我正在使用它来生成按该关键字分组的单个列表。我只是想让它拉出单个单元格，而不是像目前那样使用 .EntireRow 函数。我不知道如何去做。
Thank you for your time!
感谢您的时间！
回答by Tim Williams
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
回答by Chuck
hello is there a code that I can use to copy specific cells to another workbook by clicking a button.
您好，是否有代码可用于通过单击按钮将特定单元格复制到另一个工作簿。
here's what I am trying to do,
这就是我想要做的，
from workbook 1 I need to copy info from the following cells I have Column B info on cell A40 to A69 I have Column B info on cell b2, b3, b4, b8,9,10,11,12,13,14,15 and b40 to b69 I have column D info on cells b2, I have column G info on cell b1,b2,b3,b4
从工作簿 1 我需要从以下单元格复制信息 我在单元格 A40 到 A69 上有 B 列信息 我在单元格 b2、b3、b4、b8,9,10,11,12,13,14,15 上有 B 列信息和 b40 到 b69 我在单元格 b2 上有 D 列信息，在单元格 b1、b2、b3、b4 上有 G 列信息
all this I need to send it to workbook2 which has the same cells assigned to this specific info.
所有这些我都需要将它发送到具有分配给此特定信息的相同单元格的 workbook2。
hope I made my self clear.
希望我说清楚了。
