VBA代码，用于在两个特定文本之间复制单元格集并进行转置

首先，我必须感谢你们通过帮助像我这样的初学者做了一件不可思议的事情。还将请求您对其中一个查询提供帮助，即VBA Excel任务

我正在寻找一个VBA代码来复制列1中存在于两个特定文本之间的单元格集，并将该单元格集转置到列2

我们将通过举一个例子来说明这一点：

VBA代码开始读取第1列的第一件事——第1行、第2行、第3行等等

现在在第4行有一个名为“单击”的文本。。。。从第5行到第8行有一些“重要信息”。。。。第9行有一个名为“视图”的文本

但是，我需要从COLUMN1复制“重要信息”（第5行到第8行），并将其转置到COLUMN2>第5行

现在在第9行、第10行、第11行之后继续前进。。。第12行再次出现“单击”文本。。。。。以及从第13行到第16行的“重要信息”。。。。。和第17行的文本“视图…”。。。。同样，VBA代码将第二组单元格第13行复制到第16行，并将其转置到COLUMN2>Row13

总的来说，在“单击”和“查看”之间的第1列中存在多个集合。。。。VBA代码必须检查完整的列1，复制单元格集并将其转置到列2

抱歉，如果我的解释令人困惑，如果这看起来很难理解，请分享您的电子邮件，我可以通过电子邮件向您发送电子表格。。。。谢谢你的时间和帮助。。。附Excel图片供您参考

---

如果要转置的文本“Click”始终位于下方四行，则这将为您提供：

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'Change the Sheet name above to the sheet you will be using
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A on your Sheet
For i = 1 To LastRow 'loop from row 1 to last
    FoundClick = InStr(ws.Cells(i, 1), "Click") 'check for text "Click" in cell
    If FoundClick > 0 Then ' if the text "Click" is found
        AddressFound = ws.Cells(i + 1, 1).Address 'get the address of where Click was found
        AddressFound = Replace(AddressFound, "$", "")
        AddressTo = ws.Cells(i + 4, 1).Address 'get the next four rows below where it was found
        AddressTo = Replace(AddressTo, "$", "")

        Range(AddressFound & ":" & AddressTo).Copy 'copy the range, the four rows below where "Click" was found

        ws.Cells(i, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        'transpose onto column B
    End If
Next i
End Sub

---

你介意用段落吗？这是不可读的。请去掉“绒毛”。（这些比特告诉人们他们做得很好，感谢他们花了这么多时间，以及类似的事情，无助于解释问题。如果你不把它们编辑掉，其他人就得花时间去做。）还包括你目前正在尝试使用的代码。如果您还没有编写任何代码，那么现在就发布有关堆栈溢出的问题还为时过早。而且，正如OP在最后一句中所说，这里没有图片。Xabier-这正是我想要的工作方式。出色的工作完成了。我非常感谢您的时间和好意，及时提供了准确的代码。再次感谢您的帮助和时间。。。这看起来非常令人印象深刻，以至于您很快就找到了需求并提供了代码-令人惊讶。。。