Insere dados de um formulário de pasta de trabalho em outra planilha de pastas de trabalho

0

O que estou tentando alcançar:

Eu tenho uma pasta de trabalho com um formulário de inscrição para solicitar treinamento adicional. Uma pessoa preenche todas as células do formulário e clica em enviar.

Eu, então, quero que todos os dados do formulário personalizado sejam inseridos em outra planilha em outra pasta de trabalho.

No momento, estou usando o código abaixo, que copia corretamente todos os dados em outra planilha .... na mesma pasta de trabalho, mas eu, idealmente, preciso abrir outra pasta de trabalho e colocar os dados em uma planilha lá. Já vi pessoas postarem algumas soluções semelhantes, mas nenhuma foi adaptada às minhas necessidades.

Alguém sabe como eu adaptaria o código abaixo que escrevi, em vez de copiar para uma planilha na mesma pasta de trabalho, copie para outra planilha em uma pasta de trabalho separada.

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
    
por Nokturnyl 28.07.2018 / 18:51

1 resposta

1

Gerenciado para resolver o problema abrindo a pasta de trabalho para a qual eu queria copiar e ela selecionou as células corretas. Em seguida, coloco um comando close e save para que a pasta de trabalho basicamente se abra, transfira as informações e feche.

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

A solicitação de treinamento representa meu formulário personalizado. O treinamento de prioridades off-line é a pasta de trabalho na qual estou copiando. A autorização pendente é a folha dentro das prioridades offline de treinamento que recebe os dados transferidos.

Pensei em postar a resposta caso alguém tivesse o mesmo problema.

    
por 28.07.2018 / 22:51