Excel 将行拆分为两行,将特定单元格拉入每行

Excel 将行拆分为两行,将特定单元格拉入每行,excel,vbscript,vba,Excel,Vbscript,Vba,我需要使用excel vba将每一行复制到两行,并将原始行中的某些列分隔为第1行和第2行。我需要的内容如下所示: 输入数据: 合同(VIN)(利息)$(本金)$ 合同1\uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu 合同2$40$600 所需输出: 合同金额$ 合同1\uuuuuuuuu 1234\uuuuuuuuuuuuuuuuuuuuuuuuuuuuuu

我需要使用excel vba将每一行复制到两行,并将原始行中的某些列分隔为第1行和第2行。我需要的内容如下所示:

输入数据:
合同(VIN)(利息)$(本金)$
合同1\uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu 合同2$40$600

所需输出:
合同金额$
合同1\uuuuuuuuu 1234\uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu 合同1\uuuuuuuuu 1234\uuuuuuuuuuuuuuuuuuuuuuuuuuu$400
合同2$40 合同2$600

我正在为如何精确地在范围的行和列之间导航的概念而挣扎。。。我想这将是一个循环


如果您有任何帮助,我们将不胜感激。

请使用F8单步遍历每一行,学习此代码



你想要一张有更新信息的新工作表(这会更简单更快),还是想要修改当前工作表?我想要在新工作表中!谢谢你的时间,我真的很感激
Option Explicit

Public Sub SplitRows()
    Application.ScreenUpdating = False

    Dim newWs As Worksheet
    With ThisWorkbook.Worksheets
        Set newWs = .Add(After:=Worksheets(.Count))         'Add a new ws
        newWs.Name = Format(Now, "yyyy-mmm-dd hh-mm-ss")    'Rename it
    End With

    newWs.Range("A1:C1") = Split("Contract VIN# Amount$")   'Add headers to the new ws

    Dim colA As Range
    With ThisWorkbook.Worksheets("Sheet1").UsedRange        'Get UsedRange in colA (Sheet1)
        Set colA = .Columns("A").Offset(1).Resize(.Rows.Count - 1, 1)
    End With

    Dim itm As Range, oldRow As Long, newRow As Long
    oldRow = 1

    For Each itm In colA.Cells
        oldRow = oldRow + 1     'increment row on old sheet (Sheet1)
        newRow = newRow + 2     'increment row on new sheet (double)
        With newWs
            .Cells(newRow, "A") = Sheet1.Cells(oldRow, "A")     'row1new(A) = row1old(A)
            .Cells(newRow, "B") = Sheet1.Cells(oldRow, "B")     'row1new(B) = row1old(B)
            .Cells(newRow, "C") = Sheet1.Cells(oldRow, "C")     'row1new(C) = row1old(C)
            .Cells(newRow + 1, "A") = Sheet1.Cells(oldRow, "A") 'row2new(A) = row1old(A)
            .Cells(newRow + 1, "B") = Sheet1.Cells(oldRow, "B") 'row2new(B) = row1old(B)
            .Cells(newRow + 1, "C") = Sheet1.Cells(oldRow, "D") 'row2new(C) = row1old(D)
        End With
    Next
    Application.ScreenUpdating = True
End Sub