VBA 宏将单元格移动到新工作表并删除 Excel 中的单元格标题

Question

我正在尝试创建一个 VBA 宏以将工作表 1 上的内容移动到工作表 2 上的行。这与此处发布的问题非常相似，但我无法让宏为我工作，因为我不明白答案的可变部分。 Previously Answered Question
我们将把一块信息粘贴到一张表中，如下所示，A 列中的所有数据跨多个单元格：

问题描述：测试。

优先级：标准

个人编号：xxxxxxx

遭遇号：xxxxxxx

报告人：John CC X. Smith 2015 年 5 月 12 日上午 11:40 TSTEST2 (jsmith)

模板名称：fts_clinical_guide_8310

因此，我们想要将问题描述单元格中的信息移动到工作表 2 上的一行，其中仅在“：”之后的文本等其他单元格。我还需要所有单元格信息在移动到第 2 表时保持在 1 行中。我希望这是有道理的，我非常感谢任何帮助。谢谢。

编辑：这是我要修改的代码。它提到了我稍后会更改的原始答案“标题”。例如，它提到了 MyID="" 而我不知道如何将信息放入引号中以使其工作。

Sub MoveOver() 

Cells(1, 1).Activate 

myId = ""
myTitle = ""
myAuthor = ""

While Not ActiveCell = ""

If UCase(Left(ActiveCell, 4)) Like "*ID*" Then myId = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

If UCase(Left(ActiveCell, 4)) = "TITL" Then myTitle = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

If UCase(Left(ActiveCell, 4)) = "AUTH" Then myAuthor = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

If ActiveCell Like "*---*" Then
    'NOW, MOVE TO SHEET2!
    toRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    Sheets(2).Cells(toRow, 1) = myId
    Sheets(2).Cells(toRow, 2) = myTitle
    Sheets(2).Cells(toRow, 3) = myAuthor
    myId = ""
    myTitle = ""
    myAuthor = ""
End If

ActiveCell.Offset(1, 0).Activate

Wend

Answer 1

这对你有用

Sub SpecialCopy()
    Dim trg As Worksheet
    Set trg = ThisWorkbook.Worksheets(2)
    Dim i As Long, j As Long
    Dim lastRow As Long: lastRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
    Dim lastRow2 As Long: lastRow2 = trg.Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
    For i = 1 To lastRow ' assuming we starting from second row
        trg.Cells(lastRow2, i).Value = Split(Cells(i, 1).Value, ":")(0)
        For j = 1 To UBound(Split(Cells(i, 1).Value, ":"))
            trg.Cells(lastRow2 + 1, i).Value = trg.Cells(2, i).Value & Split(Cells(i, 1).Value, ":")(j)
        Next j
    Next i
End Sub

编辑：我已经编辑了代码，如果这对你有用，请告诉我。