The code is working but slow. Is there a way to speed it up or make it more compact but still easy to read?There are 35 different jobs to be done. They are made in a worksheet with merged cells to enter, who did the job, when, how long, workorder, nr, etc. Next to the layout is a command button, and when you click on it, it will copy all the values to a list in another WorkFile.Private Sub CommandButton2_Click()GetBook = ActiveWorkbook.NameApplication.ScreenUpdating = FalseCall OpenFileCall ReadOnlyCall FindLastRowSet rng = Worksheets(PHASE).Range(N13:O16)With CommandButton2    .Caption = Is al Ingegeven    .Left = rng.Left    .Top = rng.Top    .Width = rng.Width    .Height = rng.Height    .WordWrap = TrueEnd With        'Tail Nummer    Windows(GetBook).Activate    Range(A1).Select    Call CopyTailNum        'Datum    Windows(GetBook).Activate    Range(B14).Select    Call CopyDate        'Naam    Windows(GetBook).Activate    Range(B16).Select    Call CopyNaam        'Werk    Windows(GetBook).Activate    Range(A13).Select    Call CopyWerk        'Start Uur    Windows(GetBook).Activate    Range(E14).Select    Call CopyStartUur        'Eind Uur    Windows(GetBook).Activate    Range(E15).Select    Call CopyEindUur        'Remarks    Windows(GetBook).Activate    Range(H16).Select    Call CopyRemarks        'WOnr    Windows(GetBook).Activate    Range(K13).Select    Call CopyWONrCall UpdateTableWorkbooks(StartBlad.xlsm).SaveWindows(GetBook).ActivateApplication.ScreenUpdating = TrueCall UpdateMessageEnd SubHere is the second command button:Private Sub CommandButton3_Click()GetBook = ActiveWorkbook.NameApplication.ScreenUpdating = FalseCall OpenFileCall ReadOnlyCall FindLastRowSet rng = Worksheets(PHASE).Range(N18:O21)With CommandButton3    .Caption = Is al Ingegeven    .Left = rng.Left    .Top = rng.Top    .Width = rng.Width    .Height = rng.Height    .WordWrap = TrueEnd With        'Tail Nummer    Windows(GetBook).Activate    Range(A1).Select    Call CopyTailNum        'Datum    Windows(GetBook).Activate    Range(B19).Select    Call CopyDate        'Naam    Windows(GetBook).Activate    Range(B21).Select    Call CopyNaam        'Werk    Windows(GetBook).Activate    Range(A18).Select    Call CopyWerk        'Start Uur    Windows(GetBook).Activate    Range(E19).Select    Call CopyStartUur        'Eind Uur    Windows(GetBook).Activate    Range(E20).Select    Call CopyEindUur        'Remarks    Windows(GetBook).Activate    Range(H21).Select    Call CopyRemarks        'WOnr    Windows(GetBook).Activate    Range(K18).Select    Call CopyWONrCall UpdateTableWorkbooks(StartBlad.xlsm).SaveWindows(GetBook).ActivateApplication.ScreenUpdating = TrueCall UpdateMessageEnd SubIf you can see, the difference between the 2 buttons is the placement and the Range.I have 35 buttons.Here are the subs that are called.Sub CopyTailNum()    Selection.Copy    Windows(StartBlad.xlsm).Activate    Worksheets(WorkFile).Range(A & LastRow + 1).Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=FalseEnd SubSub CopyDate()    Selection.Copy    Windows(StartBlad.xlsm).Activate    Worksheets(WorkFile).Range(B & LastRow + 1).Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,     SkipBlanks _        :=False, Transpose:=FalseEnd SubSub CopyNaam()    Selection.Copy    Windows(StartBlad.xlsm).Activate    Worksheets(WorkFile).Range(C & LastRow + 1).Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=FalseEnd SubSub CopyWerk()    Selection.Copy    Windows(StartBlad.xlsm).Activate    Worksheets(WorkFile).Range(D & LastRow + 1).Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=FalseEnd SubSub CopyStartUur()    Selection.Copy    Windows(StartBlad.xlsm).Activate    Worksheets(WorkFile).Range(E & LastRow + 1).Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=FalseEnd SubSub CopyEindUur()    Selection.Copy    Windows(StartBlad.xlsm).Activate    Worksheets(WorkFile).Range(F & LastRow + 1).Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=FalseEnd SubSub CopyRemarks()    Selection.Copy    Windows(StartBlad.xlsm).Activate    Worksheets(WorkFile).Range(G & LastRow + 1).Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=FalseEnd SubSub CopyWONr()    Selection.Copy    Windows(StartBlad.xlsm).Activate    Worksheets(WorkFile).Range(H & LastRow + 1).Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=FalseEnd SubFunction WorkbookOpen(WorkBookName As String) As BooleanWorkbookOpen = FalseOn Error GoTo WorkBookNotOpenIf Len(Application.Workbooks(WorkBookName).Name) > 0 Then    WorkbookOpen = True    Exit FunctionEnd IfWorkBookNotOpen:End FunctionSub OpenFile()Dim File As StringDim wkBk As WorkbookFile = Worksheets(PHASE).Range(W1) & \ & StartBlad.xlsmIf WorkbookOpen(StartBlad.xlsm) Then'    Workbooks(StartBlad.xlsm).ActivateElse: Workbooks.Open (File)End IfEnd SubSub ReadOnly()    If ActiveWorkbook.ReadOnly Then        MsgBox (!!! STARTBLAD IS READ-ONLY. GEEN GEGEVENS DOORGEVOERD !!!)        ActiveWorkbook.Close        End    End IfEnd SubSub FindLastRow()Workbooks(StartBlad.xlsm).ActivateWorksheets(WorkFile).ActivateWith ActiveSheet    LastRow = .Cells(.Rows.count, A).End(xlUp).RowEnd WithEnd SubSub UpdateTable()ActiveSheet.ListObjects(WorkFileTable).Resize Range($A$1:$H$ & LastRow + 1)End SubIf needed I can link the complete excel file.
Copying data entry values in to a separate WorkFile
vba;excel