vba 使用 Excel 中的按钮将信息从一个工作表复制到另一个新行

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/22514690/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-12 02:25:20  来源:igfitidea点击:

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

excelvbaexcel-vba

提问by user3438974

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.

我有一本工作簿,里面有两张纸。Sheet 1 的布局看起来像一个带有提交按钮并命名为TravelRequest的表单。表 2 只是从表 1 中收集并命名为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
  1. Sheet 1 上的用户填写 Excel 表单的适当部分
  2. 用户点击提交按钮
  3. 数据被复制到工作表 2 中其自己的列中的所有 1 行并清除工作表 1 条目
  4. 当下一个用户填写表单时,它应该在工作表 2 中添加一个新的 ROW

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.

如果有人需要它来帮助这里,我可以将 Excel 工作表上传到某个地方。

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

有了 druciferre 的回答,我收到了这个错误

ERROR OVERFLOW

错误溢出

on this line

在这条线上

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

Here is the updated refTablearray.

这是更新后的refTable数组。

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")

采纳答案by Drew Chapin

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 refTablearray, each item is a translation of the form field to the destination column. So, if L5from the form is supposed to go column Bon the log, then you write B = L5. The code can handle with the spaces or without.

refTable数组中,每一项都是表单字段到目标列的转换。所以,如果L5从表单应该去B日志上的列,那么你写B = L5. 代码可以处理有空格或没有空格。