Question

对不起。这是我今天的最后一个问题。在我问之前，我一直在努力寻找答案。我感谢你们给予的所有帮助。

我有下面的宏代码..我的代码限制是我必须在范围内键入每个单词以搜索匹配的工作表名称..但是，我希望vba从每个单词中找到工作表名称工作表'说明'中的范围r2：r19 ..复制该活动单元格行T：AE并将粘贴值转置到找到的工作表（本例中为CDH）范围'D4：D15'

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)

VBA-搜索工作表名称来自范围..然后从范围表复制，粘贴转置到该工作表名称

2 个答案: