VBA代码将数据输入从手动制作的Excel表单链接到数据库

Question

我在Sheet1中制作了一个如下所示的Excel表单（仅作为示例）：

我想将C5，C6，C7或其他列中的数据链接到工作表Data，其中我有这样的列：

我想要的是，当用户填写表单并单击提交时，表单中的数据将链接到工作表Data，并在每次提交表单中的新数据时创建新行。

这是我到目前为止所做的，但是此代码无法正常工作：

Sub Submit_Form()

  Dim LastRow As Long, ws As Worksheet

   Set ws = Sheets("Data")

   LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1

    ws.Range("B" & LastRow).Value = Worksheets("Sheet1").C5 
    ws.Range("C" & LastRow).Value = Worksheets("Sheet1").C6 
    ws.Range("D" & LastRow).Value = Worksheets("Sheet1").C7 
    ws.Range("E" & LastRow).Value = Worksheets("Sheet1").C8 
End Sub

错误消息说：Runtime Error 438: Object doesn't support this property or method.

有人可以帮助解决这个问题吗？任何帮助是极大的赞赏。谢谢！

Answer 1

您快到了：

ws.Range("B" & LastRow).Value = Worksheets("Sheet1").C5 

应更改为：

ws.Range("B" & LastRow).Value = Worksheets("Sheet1").Range("C5").value

要清除第二个表格中的内容，您可以像这样：

Sub Clearform()

Worksheets("Sheet1").Range("C5:C8,G8,H7").clearcontents

End Sub

Answer 2

您可以使用WorksheetFunction.Transpose()

一行完成操作

Option Explicit

Public Sub Submit_Form()
    Dim ws As Worksheet
    Set ws = Sheets("Data")

    Dim LastRow As Long
    LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1

    Dim SourceRange As Range
    Set SourceRange = Worksheets("Sheet1").Range("C5:C8")

    ws.Cells(LastRow, "B").Resize(ColumnSize:=SourceRange.Rows.Count).Value = Application.WorksheetFunction.Transpose(SourceRange)

    SourceRange.ClearContents 'clear form
End Sub

要添加更多不需要转置的单元格，可以这样添加它们：

Option Explicit

Public Sub Submit_Form()
    Dim wsDest As Worksheet
    Set wsDest = Worksheets("Data")

    Dim LastRow As Long
    LastRow = wsDest.Range("B" & Rows.Count).End(xlUp).Row + 1


    Dim wsSrc As Worksheet
    Set wsSrc = Worksheets("Sheet1")

    Dim TransposeRange As Range
    Set TransposeRange = wsSrc.Range("C5:C8")

    wsDest.Cells(LastRow, "B").Resize(ColumnSize:=TransposeRange.Rows.Count).Value = Application.WorksheetFunction.Transpose(TransposeRange)
    wsDest.Cells(LastRow, "F").Value = wsSrc.Range("G5")
    wsDest.Cells(LastRow, "G").Value = wsSrc.Range("H7")

    'clear form
    TransposeRange.ClearContents
    wsSrc.Range("G5,H7").ClearContents
End Sub