将一个工作簿表单中的数据输入另一个工作簿的工作表中

Question

我想要实现的目标：

我有一本工作簿，里面有一份申请表，用于请求额外培训。一个人填写了表格上的所有单元格，然后单击“提交”。

然后，我希望将自定义表单中的所有数据输入到另一个工作簿的另一张工作表中。

我目前正在使用以下代码，该代码可以正确地将所有数据复制到另一个工作表中....在同一个工作簿中，但我理想情况下需要它打开另一个工作簿并将数据放入那里的工作表中。我见过有人发布了一些类似的解决方案，但没有一个适合我的需求。

有谁知道我该如何修改下面我编写的代码，而不是复制到同一工作簿中的工作表，而是复制到单独工作簿中的另一个工作表。

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

Answer 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

培训请求代表我的自定义表格。培训离线优先级是我要复制到的工作簿。待授权是培训离线优先级中接收传输数据的工作表。

我想我会发布答案以防有人遇到同样的问题。