jsc0518

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 235
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-26

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2019-2-14 19:37 | 只看該作者

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

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

test.rar (22.11 KB)

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

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

樓主熱帖

Just do it.

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 235
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2024-11-26

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

3^#

發表於 2019-2-15 20:04 | 只看該作者

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

Just do it.

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-26

2^#

發表於 2019-2-15 10:25 | 只看該作者

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

TOP