vba Excel 宏 - 将 Sheet2 中的单元格范围复制到具有特定文本的单元格下方的 Sheet 1
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/17277584/
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 Macro - Copy Range Of Cells in Sheet2 to Sheet 1 below Cell With Specific Text
提问by user2501574
I need to do is the following using an Excel Macro.
我需要做的是以下使用 Excel 宏。
- Go to Sheet 2 Copy Range of text L3 to R26
- Then go back to Sheet 1 search for cell containing text "Recess Size" in column L
- Then paste copied Range starting at cell containing "Recess Size"
- This needs to repeat until the end of the column.
- 转到第 2 页复制文本 L3 到 R26 的范围
- 然后返回到第 1 页,在 L 列中搜索包含文本“Recess Size”的单元格
- 然后粘贴复制的范围从包含“凹槽大小”的单元格开始
- 这需要重复直到列的末尾。
This is the code I have come up with using the Microsoft Support Page
这是我使用 Microsoft 支持页面提出的代码
Dim x As Integer
NumRows = Range("L2", Range("L600").End(xldown)).Rows.Count
Range("L2").Select
For x = 1 To NumRows
Sheets("Sheet2").Select
Range("A1:G24").Select
Selection.Copy
Sheets("Sheet1").Select
Cells.Find(What:="Recess Size", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Next
Unfortunately this goes into a continuous loop and will not stop until I press ESC and every other occurrence of the action is pasted 1 column to the left? Is there anything in the code that isn't right?
不幸的是,这进入了一个连续循环,直到我按 ESC 并且每次发生的动作都粘贴到左侧 1 列后才会停止?代码中是否有任何不正确的地方?
Hope someone can help.
希望有人能帮忙。
回答by artis_meditari
Activesheet and Activecell are too vague.
Activesheet 和 Activecell 太含糊了。
If you are working with a multisheet program it is good practice to specify which sheet you are working in or use a "With Sheets("Sheet1")" for a multiple of "Sheet1".
如果您正在使用多表程序,最好指定您正在使用的工作表或使用“With Sheets("Sheet1")”作为“Sheet1”的倍数。
This may not be a cut and paste but you get my meaning:
这可能不是剪切和粘贴,但你明白我的意思:
Sub Sheetspractice()
NumRows = Sheets("Sheet1").Range("L2:L" & Rows.Count).End(xlup).Row
Sheets("Sheet1").Range("L2").Select
For x = 1 To NumRows
Sheets("Sheet2").Range("A1:G24").Select
Selection.Copy
Sheets("Sheet1").Cells.Find(What:="Recess Size", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Sheets("Sheet1").Paste
Sheets("Sheet1").Range("A1").Offset(1, 0).Select
Next
End Sub