Excelmacros – 将数据复制到新行

我以前从来没有用excel做过这样的事情，所以可以做一些build议。

我有一个非常简单的表单，它具有一个基本的表单，当用户完成表单时，我希望他们单击​​保存button，然后将表单中的数据插入到新行中。

希望这张图解释。 Marcus的细节已经被添加到表单中，当点击SAVE时，我需要添加一个新的行（11）与Marcus的细节。

这可能吗 ？ 有人能指点我吗？

这是我第一次看到macros，并在Excel中做这样的事情。

使用macroslogging器，我可以从C3：C5＆G3：G5复制数据并粘贴到第11行，但是如何添加新行并粘贴到该行。 最后如何将macros绑定到SAVE单元？

Sub Copy() ' ' Copy Macro ' ' Range("C3:C5").Select Selection.Copy Range("A11").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("G3:G5").Select Application.CutCopyMode = False Selection.Copy Range("D11").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True End Sub 

Answer 1

在左下angular的macroslogging器是一个很好的起点（这是红圈覆盖在它的forms）：

如果不在那里，请右键单击并select它（如下所示）：

然后logging你想要自动发生的事情，那就是你的出发点

更新：

你需要创build一个保存button，在这里你做一个button，并将复制macros分配给：

这里是你更新的代码（见我已经包含在“”“符号后面的注释：

 Sub Copy() Range("C3:C5").Copy ' this replaces the select, then copy steps and is better syntax Range("A" & Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True ' The pastes relative to the last row (you code was an absolete referance to row 11 - hence it being overwritten) Range("G3:G5").Copy ' As per first comment Range("D" & Range("D" & Cells.Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True ' As per second comment Application.CutCopyMode = False ' escapes from copy/paste mode End Sub 

Answer 2

尝试下面的VBA程序。

我已经根据你在问题中提出的表单写了它。 字段的位置是硬编码的。

 Public Sub SubmitForm() Dim horizontalPosition As Integer Dim formSheet As Worksheet Set formSheet = ThisWorkbook.Worksheets(1) horizontalPosition = Application.WorksheetFunction.CountA(formSheet.Range("A9:A1000")) + 9 formSheet.Cells(horizontalPosition, 1).Value = formSheet.Cells(3, 3).Value formSheet.Cells(horizontalPosition, 2).Value = formSheet.Cells(4, 3).Value formSheet.Cells(horizontalPosition, 3).Value = formSheet.Cells(5, 3).Value formSheet.Cells(horizontalPosition, 4).Value = formSheet.Cells(3, 7).Value formSheet.Cells(horizontalPosition, 5).Value = formSheet.Cells(4, 7).Value formSheet.Cells(horizontalPosition, 6).Value = formSheet.Cells(5, 7).Value End Sub 

Answer 3

这将使用一个数组来存储，然后在下一行打印你的信息
（更多细节见评论！）

数组的速度要比表单快很多

我也join了最后一部分来清理你的表单input！ （如果你不需要，你可以删除或注释它）

 Public Sub Test_Tom() '''Define an array to contain your data Dim DatAa() As Variant ReDim DatAa(1 To 1, 1 To 6) '''Define the sheet you want to work on Dim wS As Worksheet Set wS = ThisWorkbook.ActiveSheet '''or 'Set wS = ThisWorkbook.Sheets("Sheet's Name") '''Fill the data array DatAa(1, 1) = wS.Range("C3").Value DatAa(1, 2) = wS.Range("C4").Value DatAa(1, 3) = wS.Range("C5").Value DatAa(1, 4) = wS.Range("G3").Value DatAa(1, 5) = wS.Range("G4").Value DatAa(1, 6) = wS.Range("G5").Value '''Find the first available row Dim NextRow As Long NextRow = wS.Range("A" & wS.Rows.Count).End(xlUp).Row + 1 '''Print your data in there! wS.Range("A" & NextRow).Resize(UBound(DatAa, 1), UBound(DatAa, 2)).Value = DatAa '''Clean your form wS.Range("C3").Value = vbNullString wS.Range("C4").Value = vbNullString wS.Range("C5").Value = vbNullString wS.Range("G3").Value = vbNullString wS.Range("G4").Value = vbNullString wS.Range("G5").Value = vbNullString End Sub 

Answer 4

你可以把它与你的Worksheet_Change事件，并检查是否有人更改单元格“J6”（您放置您的“保存”

 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim PasteRow As Long, C As Range If Not Intersect(Range("J6"), Target) Is Nothing Then '<-- check if the value in Cell J6 has cahnged, only then run the code below PasteRow = Range("A9").End(xlDown).Row + 1 ' <-- find first empty row in Column A Set C = Range("A" & PasteRow) '<-- set the first cell, at column A C.Value = Range("C3").Value C.Offset(, 1).Value = Range("C4").Value C.Offset(, 2).Value = Range("C5").Value C.Offset(, 3).Value = Range("G3").Value C.Offset(, 4).Value = Range("G4").Value C.Offset(, 5).Value = Range("G5").Value End If End Sub 

Answer 5

尝试将此macros绑定到您的button。 MacroToBindOnButton

 Type employee Name As String Email As String Phone As String ID As String StaffNo As String Location As String End Type Sub MacroToBindOnButton() ' Create new Employee from sheet Dim newEmployee As employee newEmployee = createNewEmployee(newEmployee) result = saveNewEmployee(newEmployee) End Sub Function createNewEmployee(employee As employee) As employee employee.Name = ActiveWorkbook.activeSheet.Cells(2, 3).Value employee.Email = ActiveWorkbook.activeSheet.Cells(3, 3).Value employee.Phone = ActiveWorkbook.activeSheet.Cells(4, 3).Value employee.ID = ActiveWorkbook.activeSheet.Cells(2, 7).Value employee.StaffNo = ActiveWorkbook.activeSheet.Cells(3, 7).Value employee.Location = ActiveWorkbook.activeSheet.Cells(4, 7).Value createNewEmployee = employee End Function Function saveNewEmployee(newEmployee As employee) Dim i As Integer i = 9 Do While activeSheet.Cells(i, 1).Value <> "" i = i + 1 Loop ' Save it into the rows ActiveWorkbook.activeSheet.Cells(i, 1).Value = newEmployee.Name ActiveWorkbook.activeSheet.Cells(i, 2).Value = newEmployee.Email ActiveWorkbook.activeSheet.Cells(i, 3).Value = newEmployee.Phone ActiveWorkbook.activeSheet.Cells(i, 4).Value = newEmployee.ID ActiveWorkbook.activeSheet.Cells(i, 5).Value = newEmployee.StaffNo ActiveWorkbook.activeSheet.Cells(i, 6).Value = newEmployee.Location End Function