VBA宏可将单元格移至新工作表并在Excel中删除单元格标题

Question

我正在尝试创建一个VBA宏，以将工作表1上的内容移动到工作表2上的行。这与此处发布的问题非常相似，但是由于我不了解可变部分，因此我无法使用该宏的答案。 先前回答的问题
我们将一块信息粘贴到看起来像这样的工作表中，所有数据都在A列中跨多个单元格：

问题说明：测试。

优先顺序：标准

人员编号：xxxxxxx

遭遇号：xxxxxxx

报道者：约翰·CC·史密斯（John CC X. Smith）2015年5月12日上午11:40 TSTEST2（jsmith）

模板名称：fts_clinical_guide_8310

因此，我们希望将“问题描述”单元格中的信息移至工作表2上一行，且其文本仅在“：”之后，以此类推。 当单元格信息移到工作表2时，我还需要所有这些信息保持在第一行。我希望这是有道理的，对此我将给予很大的帮助。 谢谢。

编辑：这是我要修改的代码。 它提到了我稍后将更改的原始答案“标题”。 例如，它提到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

编辑：我已经编辑了代码，请让我知道这是否适合您。