Excel Macro - копировать данные в новую строку

Question

Я никогда не использовал excel, чтобы делать что-либо подобное раньше, поэтому мог бы сделать некоторые советы.

У меня очень простой лист, который имеет базовую форму, когда пользователь заполняет форму, которую я хочу, чтобы они нажали кнопку сохранения, и данные из формы затем вставляются в новую строку.

Надеемся, что это изображение объясняет. Детали Marcus добавлены в форму, когда щелкнут SAVE. Мне нужно добавить новую строку (11) с подробностями Marcus.

Возможно ли это? Может ли кто-нибудь указать мне в правильном направлении?

Это первый раз, когда я смотрел макросы и делал что-то подобное в excel.

Использование макрорекордера Я могу скопировать данные из C3: C5 & 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

записи макросов в нижнем левом углу является хорошим местом для начала (это форма с красным кружком накладывая на него):

Если его нет, то право нажмите и выберите его (как показано ниже):

Затем запишите то, что вы хотите, чтобы произошло automaticall у и что это вы отправную точку

Изменено:

Вам нужно создать кнопку сохранить, вот где вы сделать кнопку и назначить копию макрос:

И вот вы обновленный код (см. Комментарии, которые я включил, которые после символа «» означают:

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