Пользовательская форма вводит данные в отдельный рабочий лист. Как мне сделать так, чтобы затем экстраполировать эти данные на другой лист, на две новые строки?

Question

Я создал пользовательскую форму, которая открывается, когда я выбираю командную кнопку. Цель этого состоит в том, чтобы захватить данные из выбранной строки, относящиеся к «туру» - то есть коду тура, дате начала и дате окончания, а затем для меня «разделить» тур, для которого мне нужно ввести новые коды тура, даты начала и окончания.

Данные из формы помещаются на отдельный лист (называемый «разделением»), поэтому у меня есть запись исходных данных о поездке и новых данных о поездке на одном листе. Данные выложены следующим образом:

[A] Оригинальный код тура | [B] Первоначальная дата начала | [C] Первоначальная дата окончания | [D] Новый код тура 1 | [E] Новая дата начала 1 | [F] Новая дата окончания 1 | [G] Новый код тура 2 | [H] Новая дата начала 2 | [I] Новая дата окончания 2 | [J] Причина разделения

Таким образом, пользовательская форма вставляет все данные в эти столбцы - это прекрасно работает, и я доволен этим.

Я пытаюсь затем сделать это, затем скопировать детали новых туров в нижние два ряда исходного листа («Заключительные туры») и удалить старые детали туров из этого листа. Но я не знаю, как заставить его скопировать новые детали тура (например, D: F и G: H на листе «Разделение»), а затем удалить исходную строку?

Это мой код на данный момент:

Object 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).Row
        With .Offset(2, 0).EntireRow.Row
            .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

    'no need to copy from the Splits sheet since you have the data
    ' in the form fields
    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 the split tour

    MsgBox "Tour " & wsSplits.Cells(ActiveCell.Row, "A").Value & _
      " has been split to " & wsSplits.Cells(ActiveCell.Row, "D").Value & _
      " and " & wsSplits.Cells(ActiveCell.Row, "G")

End Sub


Private Sub CloseCommand_Click()

Unload Me

End Sub

Есть мысли? Вся помощь очень ценится.

Answer 1

Вы можете сделать что-то вроде этого:

Option Explicit

Dim originalRow As Range

Private Sub UserForm_Initialize()
    Set originalRow = ActiveCell.EntireRow '<< store this row in a global variable
    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

    'snipped autofilter code...

    With wsSplits.Cells(Rows.Count, "A").End(xlUp)
        .Offset(1, 0) = workOrderDescription
        With .Offset(2, 0).EntireRow
            .Cells(1) = OriginalTourCode.Text
            .Cells(2) = OriginalStartDate.Text
            .Cells(3) = OriginalEndDate.Text
            'etc etc for the other cells
        End With
    End With

    'no need to copy from the Splits sheet since you have the data
    ' in the form fields
    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 the split tour

    MsgBox "Tour " & ws.Cells(ActiveCell.Row, "A").Value & _
      " has been split to " & ws.Cells(ActiveCell.Row, "D").Value & _
      " and " & ws.Cells(ActiveCell.Row, "G")

End Sub