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.我希望这是有道理的，我真的很感激任何帮助。感谢。

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

编辑：我已经编辑了代码，请告诉我这是否适合您。

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

1 个答案: