Excel – Use a button in Excel to copy information from one sheet to another on a new row

excelvba

I have one workbook with two sheets. Sheet 1 is laid out to look like a form with a submit button and named TravelRequest. Sheet 2 is just a database that is collected from sheet 1 and named TravelLog.

Here is how it works now:

  1. User on Sheet 1 fills out the proper sections of the Excel form
  2. User clicks on the Submit button
  3. Data gets copied onto Sheet 2 in its own columns all in 1 row and clears Sheet 1 entries
  4. When the next user fills out the form it should add a new ROW in Sheet 2

So, right now my script copies one cell to another specified cell and I tried many different codes from this website but cant seem to get any to work, also my copy script is hardcoded copy & paste operations. I don't know how to work around that.

I can upload the Excel sheet somewhere if anyone needs it for helping out here.

Sub Submit()
    Application.ScreenUpdating = False
    Range("L5").Copy
    Sheets("TravelLog").Range("B6").PasteSpecial xlPasteValues
    Range("C5").Copy
    Sheets("TravelLog").Range("C6").PasteSpecial xlPasteValues
    Range("G5").Copy
    Sheets("TravelLog").Range("D6").PasteSpecial xlPasteValues
    Range("c10").Copy
    Sheets("TravelLog").Range("E6").PasteSpecial xlPasteValues
    Range("c9").Copy
    Sheets("TravelLog").Range("F6").PasteSpecial xlPasteValues
    Range("I9").Copy
    Sheets("TravelLog").Range("G6").PasteSpecial xlPasteValues
    Range("I10").Copy
    Sheets("TravelLog").Range("H6").PasteSpecial xlPasteValues
    Range("C13").Copy
    Sheets("TravelLog").Range("I6").PasteSpecial xlPasteValues
    Range("C14").Copy
    Sheets("TravelLog").Range("J6").PasteSpecial xlPasteValues
    Range("C15").Copy
    Sheets("TravelLog").Range("K6").PasteSpecial xlPasteValues
    Range("C16").Copy
    Sheets("TravelLog").Range("L6").PasteSpecial xlPasteValues
    Range("C17").Copy
    Sheets("TravelLog").Range("M6").PasteSpecial xlPasteValues
    Range("C18").Copy
    Sheets("TravelLog").Range("N6").PasteSpecial xlPasteValues
    Range("i13").Copy
    Sheets("TravelLog").Range("O6").PasteSpecial xlPasteValues
    Range("i14").Copy
    Sheets("TravelLog").Range("P6").PasteSpecial xlPasteValues
    Range("i15").Copy
    Sheets("TravelLog").Range("Q6").PasteSpecial xlPasteValues
    Range("i16").Copy
    Sheets("TravelLog").Range("R6").PasteSpecial xlPasteValues
    Range("i17").Copy
    Sheets("TravelLog").Range("S6").PasteSpecial xlPasteValues
    Range("h20").Copy
    Sheets("TravelLog").Range("W6").PasteSpecial xlPasteValues

    Application.ScreenUpdating = True
End Sub

* EDIT *

With druciferre's answer, I'm getting this error

ERROR OVERFLOW

on this line

Worksheets("TravelLog").Range(Dest).Value = Worksheets("TravelRequest").Range(Field).Value

Here is the updated refTable array.

refTable = Array("B = L5", "C = C5", "D=G5", "E=C10", "F=C9", "G=I9", "H=I10", "I=C13", "J=C14", "K=C15", "L=C16", "M=C17", "N=C18", "O=I13", "P=I14", "Q=I15", "R=I16", "S=I17", "W=H20")

Best Answer

Try this...

Dim refTable As Variant, trans As Variant
refTable = Array("B = L5", "C = C5", "D=G5", "E=C10", "F=C9")
Dim Row As Long
Row = Worksheets("TravelLog").UsedRange.Rows.Count + 1 
For Each trans In refTable
    Dim Dest As String, Field As String
    Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & Row
    Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
    Worksheets("TravelLog").Range(Dest).value = Worksheets("TravelRequest").Range(Field).value
Next

In the refTable array, each item is a translation of the form field to the destination column. So, if L5 from the form is supposed to go column B on the log, then you write B = L5. The code can handle with the spaces or without.

Related Topic