Excel-Makro - Daten in neue Zeile kopieren

Question

Ich habe noch nie Excel verwendet, um so etwas zu tun, also könnte mit ein paar Tipps tun.

Ich habe ein sehr einfaches Blatt, das eine grundlegende Form hat, wenn der Benutzer das Formular vervollständigt Ich möchte, dass sie auf eine Schaltfläche zum Speichern klicken und die Daten aus dem Formular wird dann in eine neue Zeile eingefügt.

Hoffentlich dieses Bild erklärt. Marcus 'Details wurden dem Formular hinzugefügt, wenn SAVE angeklickt wird, muss ich eine neue Zeile (11) mit Marcus' Details hinzufügen.

Ist das möglich? Könnte mir jemand in die richtige Richtung zeigen?

Dies ist das erste Mal, dass ich Makros und so etwas in Excel gemacht habe.

Mit dem Makro-Recorder kann ich Daten von C3 kopieren: C5 & G3: G5 und fügen Sie sie in Zeile 11, aber wie füge ich eine neue Zeile und einfügen, um das. Wie binde ich das Makro schließlich an die SAVE-Zelle?

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

Der Makrorecorder in der unteren linken Ecke ist ein guter Anfang (es ist die Form mit dem roten Kreis auf dem Übereinanderlegen):

Wenn er nicht da ist, dann rechts klicken und wählen Sie es (wie unten):

Dann notieren, was Sie automati passieren soll y und das sind Sie Punkt

Aktualisiert fangen:

Sie auf eine Schaltfläche speichern erstellen müssen, ist hier, wo Sie auf eine Schaltfläche zu machen und die Kopie Makro zuordnen:

Und hier ist Ihr aktualisierter Code (siehe Kommentare, die ich nach dem "'" Symbol eingefügt habe:

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

Probieren Sie das folgende VBA-Verfahren aus.

Ich habe es basierend auf Form geschrieben Sie in Ihrer Frage vorgestellt. Die Position der Felder ist fest codiert.

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

Dies wird ein Array zum Speichern und Ihre Daten auf der nächsten Zeile dann
(weitere Einzelheiten finden Sie in den Kommentaren!) Drucken

Arrays viel schneller sind als eine Menge auf das Blatt mit Bezug

Ich habe auch den letzten Teil hinzugefügt, um Ihre Formulareingaben zu reinigen!(Sie können es löschen oder kommentieren, wenn Sie es nicht wollen)

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

Sie es mit Ihren Worksheet_Change Ereignis binden könnten, und prüfen, ob jemand den Wert in Zelle „J6“ ändert (wo Sie Ihre „Save platziert "

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

versuchen, dieses Makro zu yout Taste binden 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