Excel宏 - 将数据复制到新行

Question

我之前从未使用excel做过这样的事情，所以可以提出一些建议。

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

希望这张图片能够解释。 Marcus的详细信息已添加到表单中，当点击SAVE时，我需要添加一个新行（11）和Marcus的详细信息。

这可能吗？有人能指出我正确的方向吗？

这是我第一次看到宏并在excel中做这样的事情。

使用宏录制器我可以从C3复制数据：C5＆amp; G3：G5并将它们粘贴到第11行，但如何添加新行并粘贴到该行。最后，如何将宏绑定到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

左下角的宏录制器是一个很好的起点（它是红色圆圈覆盖在其上的形式）：

如果不存在，则右键单击并选择它（如下所示）：

然后记录您想要自动发生的事情以及您的起点

<强>更新

您需要创建一个保存按钮，您可以在此处创建一个按钮并将副本宏指定给：

此处您已更新代码（请参阅我在＃34;＆＃39;＆＃39;＆＃34;＆＃34;＆＃39;符号后面的评论：

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

这将使用数组存储，然后在下一行打印您的信息 （有关详细信息，请参阅评论！）

阵列比很多地引用工作表要快得多

我还添加了最后一部分来清理表单输入！ （如果你不想要它，你可以删除或评论）

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

尝试将此宏绑定到yout按钮。的 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