Чего я пытаюсь достичь:

У меня есть одна рабочая тетрадь с формой заявки на дополнительное обучение. Человек заполняет все ячейки в форме и нажимает кнопку «Отправить».

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

В настоящее время я использую приведенный ниже код, который правильно копирует все данные в другую рабочую таблицу ... в той же книге, но в идеале она мне нужна, чтобы открыть другую рабочую книгу и поместить данные в лист там. Я видел, как люди публикуют несколько похожих решений, но ни одно из них не соответствует моим потребностям.

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

Sub Submit()
'Declaring all variables
Dim TrainingSummary As String, RequestedBy As String, DeliveryMethod As String, DateRequested As Date, DueDate As Date, EmailAddress As String, Department As String, StartDate As Date, Approval As String
Dim ApprovalName As String, Headcount As Integer, TrainingDescription As String, AdditionalNotes As String, MaterialRequired As String

'Selecting my training request form sheet and then setting the contents of the cells to the variables
Worksheets("Training Request").Select
TrainingSummary = Range("E5")
DeliveryMethod = Range("E23")
RequestedBy = Range("E5")
DueDate = Range("E19")
DateRequested = Range("E15")
EmailAddress = Range("E7")
Department = Range("E9")
StartDate = Range("E17")
Approval = Range("E21")
ApprovalName = Range("H21")
MaterialRequired = Range("E25")
Headcount = Range("H23")
TrainingDescription = Range("C28")
AdditionalNotes = Range("C37")

'Selecting the worksheet I want to move the contents to and making sure entry always goes on a clear row
Worksheets("Pending Authorisation").Select
Worksheets("Pending Authorisation").Range("C3").Select
If Worksheets("Pending Authorisation").Range("C3").Offset(1, 0) <> "" Then
Worksheets("Pending Authorisation").Range("C3").End(xlDown).Select
End If

'Selecting and setting content in new rows
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = TrainingSummary
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = DeliveryMethod
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = MaterialRequired
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = RequestedBy
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Department
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = DateRequested
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = StartDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = DueDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Approval
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Headcount
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Pending"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TrainingDescription
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = AdditionalNotes

'reselecting the original form sheet and clearing
Worksheets("Training Request").Select
Worksheets("Training Request").Range("E5:I9").ClearContents
Worksheets("Training Request").Range("E13:E25").ClearContents
Worksheets("Training Request").Range("C28:M32").ClearContents
Worksheets("Training Request").Range("H21:H23").ClearContents
Worksheets("Training Request").Range("C37:M41").ClearContents
End Sub

1 ответ1

1

Удалось решить проблему, открыв книгу, в которую я хотел скопировать, и выбрал правильные ячейки. Затем я помещаю команду закрытия и сохранения, чтобы рабочая книга в основном открывалась, передавала информацию и закрывалась.

Sub Submit()
'Declaring all variables
Dim TrainingSummary As String, RequestedBy As String, DeliveryMethod As String, DateRequested As Date, DueDate As Date, EmailAddress As String, Department As String, StartDate As Date, Approval As String
Dim ApprovalName As String, Headcount As Integer, TrainingDescription As String, AdditionalNotes As String, MaterialRequired As String

'Selecting my training request form sheet and then setting the contents of the cells to the variables
Worksheets("Training Request").Select
TrainingSummary = Range("E13")
DeliveryMethod = Range("E23")
RequestedBy = Range("E5")
DueDate = Range("E19")
DateRequested = Range("E15")
EmailAddress = Range("E7")
Department = Range("E9")
StartDate = Range("E17")
Approval = Range("E21")
ApprovalName = Range("H21")
MaterialRequired = Range("E25")
Headcount = Range("H23")
TrainingDescription = Range("C28")
AdditionalNotes = Range("C37")

Workbooks.Open ("Training Offline Priorities.xlsm")
Workbooks("Training Offline Priorities.xlsm").Activate
'Selecting the worksheet I want to move the contents to and making sure entry always goes on a clear row
Worksheets("Pending Authorisation").Select
Worksheets("Pending Authorisation").Range("C3").Select
If Worksheets("Pending Authorisation").Range("C3").Offset(1, 0) <> "" Then
Worksheets("Pending Authorisation").Range("C3").End(xlDown).Select
End If

'Selecting and setting content in new rows
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = TrainingSummary
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = DeliveryMethod
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = MaterialRequired
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = RequestedBy
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Department
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = DateRequested
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = StartDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = DueDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Approval
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Headcount
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Pending"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TrainingDescription
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = AdditionalNotes
Workbooks("Training Offline Priorities.xlsm").Close SaveChanges:=True
Workbooks("Training Request Form.xlsm").Activate
'reselecting the original form sheet and clearing
ThisWorkbook.Worksheets("Training Request").Select
ThisWorkbook.Worksheets("Training Request").Range("E5:I9").ClearContents
ThisWorkbook.Worksheets("Training Request").Range("E13:E25").ClearContents
ThisWorkbook.Worksheets("Training Request").Range("C28:M32").ClearContents
ThisWorkbook.Worksheets("Training Request").Range("H21:H23").ClearContents
ThisWorkbook.Worksheets("Training Request").Range("C37:M41").ClearContents

End Sub

Запрос на обучение представляет мою пользовательскую форму. Обучение в автономном режиме - это книга, в которую я копирую. Ожидание авторизации - это лист в рамках приоритетов обучения в автономном режиме, который получает переданные данные.

Я решил опубликовать ответ, если у кого-то возникнет такая же проблема.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .