如何修复将数据插入单独的工作表但在每个条目之间留下两个空白行的用户窗体,尽管要插入到下一个空白行的代码?

How to fix userform which inserts data into separate worksheet but leaves two blank rows between each entry, despite code to insert to next blank row?

我有一个用户表单,旨在将数据插入到名为 "Final tours" 和 "Splits" 的工作表中,但采用不同的方式。

我select一行"Final Tours",点击一个按钮到"Split Tour",然后输入新的游览详情。然后它将新的游览详细信息复制到 "Final Tours" 的底部(这很好用),并删除原始行。它也意味着将数据复制到 "Splits"。但是,在 "Splits" 中,虽然它正确地输入了行中的数据,但每次我向用户窗体输入新数据时,它都会从前一行中留下两个空白行。

所以如果我拆分三个游览,在 "Splits" 它会在第 1、4、7 行等而不是第 1、2、3 行显示数据。我不明白为什么要这样做.有什么想法吗?我的代码如下:

Option Explicit
Dim originalRow As Range

Private Sub UserForm_Initialize()
    Set originalRow = ActiveCell.EntireRow
    With Me
        .OriginalTourCode.Value = originalRow.Cells(1).Value
        .OriginalStartDate.Value = originalRow.Cells(2).Value
        .OriginalEndDate.Value = originalRow.Cells(3).Value
    End With
End Sub    

Private Sub SplitTourCommand_Click()

    Dim ctrl As Control
    Dim wsSplits As Worksheet
    Set wsSplits = Sheets("Splits")
    Dim wsTours As Worksheet
    Set wsTours = Sheets("Final Tours")
    Dim WSheet As Variant
    Dim DTable As Variant, RowCount As Long

    Application.ActiveWorkbook.Save

    For Each WSheet In ActiveWorkbook.Worksheets
        If wsTours.AutoFilterMode Then
            If wsTours.FilterMode Then
                wsTours.ShowAllData
            End If
        End If
        For Each DTable In wsTours.ListObjects
            If DTable.ShowAutoFilter Then
                DTable.Range.AutoFilter
                DTable.Range.AutoFilter
            End If
        Next DTable
    Next WSheet

    With wsSplits.Cells(Rows.Count, "A").End(xlUp)
        With .Offset(1, 0).EntireRow
            With .Offset(2, 0).EntireRow
                .Cells(1) = OriginalTourCode.Text
                .Cells(2) = OriginalStartDate.Text
                .Cells(3) = OriginalEndDate.Text
                .Cells(4) = NewTourCode1.Text
                .Cells(5) = NewStartDate1.Text
                .Cells(6) = NewEndDate1.Text
                .Cells(7) = NewTourCode2.Text
                .Cells(8) = NewStartDate2.Text
                .Cells(9) = NewEndDate2.Text
                .Cells(10) = ReasonForSplit.Text
                .Cells(11).Value = Date

            End With
        End With

        With wsTours.Cells(Rows.Count, "A").End(xlUp)
            .Offset(1, 0).Value = NewTourCode1.Text
            .Offset(1, 1).Value = NewStartDate1.Text
            .Offset(1, 2).Value = NewEndDate1.Text
            .Offset(2, 0).Value = NewTourCode2.Text
            .Offset(2, 1).Value = NewStartDate2.Text
            .Offset(2, 2).Value = NewEndDate2.Text
        End With

        originalRow.Delete 'remove the row the split tour

        MsgBox "Tour " & OriginalTourCode.Text & _
        " has been split to " & NewTourCode1.Text & _
        " and " & NewTourCode2.Text

        Unload Me

    End With

End Sub

Private Sub CloseCommand_Click()

    Unload Me

End Sub

在此先感谢您的帮助。

你贴了很多代码,很难给出完整的答案。相反,我会给你一些关于如何使你的代码更容易理解和调试的提示。
这部分:

With wsSplits.Cells(Rows.Count, "A").End(xlUp)
    With .Offset(1, 0).EntireRow
        With .Offset(2, 0).EntireRow

可能是罪魁祸首。根据您的预期,偏移量可能不是最后一行的偏移量是棘手的。相反,我认为您应该将行号存储在变量中:

NewRow = wsSplits.Cells(Rows.Count, "A").End(xlUp).Row

然后从那里开始工作,比如

wsSplits.Cells(NewRow + 1, "A")...