[發問] 詢問：如何將表單內資料複製到另一表單(資料庫中)

jsc0518

Dear 先進,
我有一表單於每一次填寫時，想要將表單內容複製到"資料庫"中
寫了VBA語法，但是失敗的，還請各位幫忙看一下語法教導我
感謝!

test.rar (22.11 KB)

下載次數: 8

2019-2-14 19:35

黃色底的部份是要COPY到"資料庫的，我希望每做一次表單，就可以COPY到資料庫(資料庫是持續新增的)

下載 (92.79 KB)

2019-2-14 19:36

下載 (67.26 KB)

2019-2-14 19:36

VBA語法

Private Sub CommandButton1_Click()


'指定工作表/新增一筆
    If Sheets("資料庫").Range("A2") = "" Then
        R = 2
    Else
        R = Sheets("資料庫").Range("A1").End(xlDown).Row + 1
    End If
    Sheets("資料庫").Cells(R, "A") = Sheets("送修單").Range("C3")
    Sheets("資料庫").Cells(R, "B") = Sheets("送修單").Range("E3")
    Sheets("資料庫").Cells(R, "C") = Sheets("送修單").Range("C5")
    Sheets("資料庫").Cells(R, "D") = Sheets("送修單").Range("D5")
    Sheets("資料庫").Cells(R, "E") = Sheets("送修單").Range("E5")
    Sheets("資料庫").Cells(R, "F") = Sheets("送修單").Range("G5")
    Sheets("資料庫").Cells(R, "G") = Sheets("送修單").Range("H5")

    Sheets("資料庫").Cells(R, "A") = Sheets("送修單").Range("C3")
    Sheets("資料庫").Cells(R, "B") = Sheets("送修單").Range("E3")
    Sheets("資料庫").Cells(R, "C") = Sheets("送修單").Range("C6")
    Sheets("資料庫").Cells(R, "D") = Sheets("送修單").Range("D6")
    Sheets("資料庫").Cells(R, "E") = Sheets("送修單").Range("E6")
    Sheets("資料庫").Cells(R, "F") = Sheets("送修單").Range("G6")
    Sheets("資料庫").Cells(R, "G") = Sheets("送修單").Range("H6")

    Sheets("資料庫").Cells(R, "A") = Sheets("送修單").Range("C3")
    Sheets("資料庫").Cells(R, "B") = Sheets("送修單").Range("E3")
    Sheets("資料庫").Cells(R, "C") = Sheets("送修單").Range("C7")
    Sheets("資料庫").Cells(R, "D") = Sheets("送修單").Range("D7")
    Sheets("資料庫").Cells(R, "E") = Sheets("送修單").Range("E7")
    Sheets("資料庫").Cells(R, "F") = Sheets("送修單").Range("G7")
    Sheets("資料庫").Cells(R, "G") = Sheets("送修單").Range("H7")


    Sheets("資料庫").Cells(R, "A") = Sheets("送修單").Range("C3")
    Sheets("資料庫").Cells(R, "B") = Sheets("送修單").Range("E3")
    Sheets("資料庫").Cells(R, "C") = Sheets("送修單").Range("C8")
    Sheets("資料庫").Cells(R, "D") = Sheets("送修單").Range("D8")
    Sheets("資料庫").Cells(R, "E") = Sheets("送修單").Range("E8")
    Sheets("資料庫").Cells(R, "F") = Sheets("送修單").Range("G8")
    Sheets("資料庫").Cells(R, "G") = Sheets("送修單").Range("H8")


    Sheets("資料庫").Cells(R, "A") = Sheets("送修單").Range("C3")
    Sheets("資料庫").Cells(R, "B") = Sheets("送修單").Range("E3")
    Sheets("資料庫").Cells(R, "C") = Sheets("送修單").Range("C9")
    Sheets("資料庫").Cells(R, "D") = Sheets("送修單").Range("D9")
    Sheets("資料庫").Cells(R, "E") = Sheets("送修單").Range("E9")
    Sheets("資料庫").Cells(R, "F") = Sheets("送修單").Range("G9")
    Sheets("資料庫").Cells(R, "G") = Sheets("送修單").Range("H9")


    Sheets("資料庫").Cells(R, "A") = Sheets("送修單").Range("C3")
    Sheets("資料庫").Cells(R, "B") = Sheets("送修單").Range("E3")
    Sheets("資料庫").Cells(R, "C") = Sheets("送修單").Range("C10")
    Sheets("資料庫").Cells(R, "D") = Sheets("送修單").Range("D10")
    Sheets("資料庫").Cells(R, "E") = Sheets("送修單").Range("E10")
    Sheets("資料庫").Cells(R, "F") = Sheets("送修單").Range("G10")
    Sheets("資料庫").Cells(R, "G") = Sheets("送修單").Range("H10")


    Sheets("資料庫").Cells(R, "A") = Sheets("送修單").Range("C3")
    Sheets("資料庫").Cells(R, "B") = Sheets("送修單").Range("E3")
    Sheets("資料庫").Cells(R, "C") = Sheets("送修單").Range("C11")
    Sheets("資料庫").Cells(R, "D") = Sheets("送修單").Range("D11")
    Sheets("資料庫").Cells(R, "E") = Sheets("送修單").Range("E11")
    Sheets("資料庫").Cells(R, "F") = Sheets("送修單").Range("G11")
    Sheets("資料庫").Cells(R, "G") = Sheets("送修單").Range("H11")

    MsgBox "新增資料成功!", 0 + 64
   
   
End Sub

准提部林

Private Sub CommandButton1_Click()
Dim xR As Range, xE As Range
For Each xR In [C5:C11]
    If xR = "" Then GoTo 101
    Set xE = [資料庫!A65536].End(xlUp)(2).Resize(1, 7)
    xE = Array([C3], [E3], xR, xR(1, 2), xR(1, 3), xR(1, 5), xR(1, 6))
101: Next
End Sub

jsc0518

回復 2# 准提部林
Dear 准提部林,
真的很感激您的指導，太感恩了！