VBA-从范围search表单名称，然后从范围表复制，将转置粘贴到该表单名称中

抱歉。 这是我今天的最后一个问题。 在我问之前，我一直试图find答案。 我感谢你们的帮助。

我有下面的macros代码..我的代码限制是，我必须input范围内的每个单词来search它的匹配sheetname ..但是，我希望vbafind每个单词的范围r2：r19在工作表'说明'中的sheetname。 。复制活动单元格行T：AE，并在范围'D4：D15'中将pastevalue转置到find的表单（此例中为CDH）

Sub PasteBudget() Sheets("instructions").Select Columns("R2:R19").Select On Error Resume Next Selection.Find(What:="CDH", After:=ActiveCell, LookIn:= _ xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _ xlNext, MatchCase:=False, SearchFormat:=False).Activate 'If Err.Number = 91 Then 'MsgBox "ERROR: 'CDH' could not be found." ' End 'End If Dim intRow As Integer intRow = ActiveCell.Row range("T" & intRow & ":AE" & intRow).Copy Sheets("CDH").Select range("D4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True End Sub 

Answer 1

这应该做你想要的，没有任何错误：

 Sub PasteBudget() Dim rng As Range With Sheets("instructions") Set rng = .Range("R2:R19").Find("CDH", , xlFormulas, 2, , 1, 0, , 0) If Not rng Is Nothing Then Intersect(rng.EntireRow, .Columns("T:AE")).Copy Sheets("CDH").Range("D4").PasteSpecial xlPasteValues, , , 1 End If End With End Sub 

编辑
在你编辑之后，应该这样做：

 Sub PasteBudget() Dim rng As Range, sh As Worksheet With Sheets("instructions") For Each sh In Worksheets Set rng = .Range("R2:R19").Find(sh.Name, , xlFormulas, 2, , 1, 0, , 0) If Not rng Is Nothing And sh.Name <> .Name Then Intersect(rng.EntireRow, .Columns("T:AE")).Copy sh.Range("D4").PasteSpecial xlPasteValues, , , 1 End If Next End With End Sub 

Answer 2

你可以写简单的代码：

 Dim sheetCDH as Worksheet Set sheetCDH =ThisWorkbook.Sheets("CDH ") ThisWorkbook.Sheets("instructions").Range("T" & intRow & ":AE" & intRow).Copy Destination:=sheetCDH .Cells(4, 4)