Excel VBA：从一个工作表复制到另一个
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19438471/
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
Excel VBA: Copy from one worksheet to another
提问by user2892425
So I have a workbook with two sheets in it. I need to copy data from worksheet 2 ("Detail") to worksheet 1 ("Syncrofit"). The items from ws2 I need to paste into progressive rows on sheet 1, so rows in sheet two, column B which say "Joint1-1" need to be inserted below row 1 on sheet 1. This essentially creates a nested table.
所以我有一个工作簿，里面有两张纸。我需要将数据从工作表 2（“详细信息”）复制到工作表 1（“Syncrofit”）。ws2 中的项目我需要粘贴到工作表 1 上的渐进行中，因此工作表 2 中的行 B 列需要插入工作表 1 上的第 1 行下方。这实际上创建了一个嵌套表。
Here's what I have so far, mostly scraped together from code and help I've found around here:
到目前为止，这是我所拥有的，主要是从代码和我在这里找到的帮助中拼凑出来的：
Sub SelectJoints()
Sheets("Detail").Activate
Dim Selection1 As Integer, Selection2 As Integer
Dim SelectionRange As Range
Dim num As Integer
Dim rngFind As Range
Set rngFind = Columns("B:B").Find(what:="*" & "Joint1-" & num, After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngFind Is Nothing Then
Selection1 = rngFind.Row + 1
End If
Set rngFind = Columns("B:B").Find(what:="*Joint1-" & num + 1, After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngFind Is Nothing Then
Selection2 = rngFind.Row - 1
End If
If Selection1 > 0 And Selection2 > 0 Then
Set SelectionRange = Range(Cells(Selection1, 2), Cells(Selection2, 6))
End If
End Sub
结束子
The intent here is that this should activate the detail sheet, find strings in column B which match "SomeTextHere(Joint1-1)" and select those rows. I then need it to paste those selections over to sheet 1 (below row 1, which has a value matching the "Joint" value in one of the columns), come back to sheet 2, select the rows containing "SomeTextHere(Joint1-2)" and paste those below the next row (after those which were just inserted). I realize that the pasting part of that is not in the code. This has been driving me nuts.
这里的意图是这应该激活详细信息表，在 B 列中找到与“SomeTextHere(Joint1-1)”匹配的字符串并选择这些行。然后我需要它将这些选择粘贴到工作表 1（在第 1 行下方，其值与其中一列中的“联合”值匹配），返回工作表 2，选择包含“SomeTextHere(Joint1-2 )”并将它们粘贴到下一行下方（在刚刚插入的那些之后）。我意识到粘贴部分不在代码中。这让我发疯。
Please excuse my lack of knowledge in regards to VBA.
请原谅我对 VBA 缺乏了解。
I'd like the finished product to look like a nested table kinda like follows:
我希望成品看起来像一个嵌套表，如下所示：
Original Items
Copied from sheet 2
Copied from sheet 2
Copied from sheet 2
Original Item 2
Copied from sheet 2
etc.
Any help is greatly appreciated, thanks,
非常感谢任何帮助，谢谢，
回答by stobin
I was a bit bored so I whipped up something that might help you. Let me know if it works for you.
我有点无聊所以我做了一些可能对你有帮助的事情。请让我知道这对你有没有用。
Sub Macro1()
Dim i, j, x
Dim rng As Range
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Sheets("Syncrofit")
Set sh2 = Sheets("Detail")
lr = sh2.Range("B" & Rows.Count).End(xlUp).Row
lc = sh2.Cells(2, Columns.Count).End(xlToLeft).Column
j = 2
For y = 1 To 3 ' set upper limit of first integer in Joint string
For x = 1 To 2 ' set upper limit of second integer in Joint string
For i = 2 To lr
If InStr(sh2.Cells(i, 2), "Joint" & y & "-" & x) <> 0 Then
sh2.Range(sh2.Cells(i, 1), sh2.Cells(i, lc)).Copy
sh1.Rows(j).Insert
j = j + 1
End If
Next i
Next x
Next y
End Sub
