Question

嗨，我使用一些VBA将单元格复制到同一工作簿中的另一个工作表。但是我遇到了一个错误。这是挑战：

包含要搜索的数据的工作表。
我正在A列中的单元格中循环并寻找“属性”一词：如果找到了这些单词，我想复制并粘贴特殊（转置）相邻单元格中的值（最多三行）到同一工作表中的另一个工作表工作簿。因此，例如，如果单词“在单元格A9中找到属性”，我需要复制B10：B12中的值，并将特殊转置粘贴到元数据工作表上的下一个空行中。

我可以复制单元格Offset（1,1），但是我很难扩展复制范围。请参见下面的代码。注释掉的代码可以正常工作，但是它下面的行是我正在尝试的行，但是它行不通。

Private Sub Search_n_Copy()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Dim rngCopy As Range, aCell As Range, srchRng As Range
Dim strSearch As String
Dim QueryResults As Worksheet
Set QueryResults = ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
QueryResults.Name = "MetaData"
strSearch = "Properties"
Dim LastRow As Long


With QueryResults
QueryResults.Range("A1").Value = "SI_ID"
QueryResults.Range("B1").Value = "SI_NAME"
QueryResults.Range("C1").Value = "SI_WEBI_DOC_PROPERTIES"
End With


With ws
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row in column A
Set srchRng = .Range("A1:A" & LastRow)
For Each aCell In srchRng
 If aCell.Value = "Properties" Then
 ''aCell.Offset(1, 1).Copy
 .Range("aCell.Offset(1, 1):aCell.Offset(3,1)").Copy
  QueryResults.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
 End If
 Next aCell
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

范围参考Excel VBA

0 个答案: