Question

我冒这个问题失去声誉的风险，但我需要程序员而不是高级用户。我能用PHP编写，但Excel VBA不在我的联盟中，我需要快速解决方案。

我得到了一张包含2张纸的Excel文件，＆＃34; Form＆＃34;和＆＃34;数据＆＃34;。在第一张纸上是一个按钮＆＃34; Save＆＃34;。当用户点击此按钮时，我需要做以下事情：

复制工作表中不同列的数据＆＃34; Form＆＃34; （在本例中为C2和C4）
将数据粘贴到工作表中的新行＆＃34;数据＆＃34;在一个新行上，两列水平
清除工作表中的列＆＃34;表单＆＃34;

代码是：

Private Sub SaveButton_Click()

    Application.ScreenUpdating = False

    Dim r As Range
    Set r = Sheets("Form").Range("C2,C4")
    For Each cell In r
        If IsEmpty(cell) Then
            MsgBox ("Error - all boxes must be filled in!")
            Cancel = True
            Exit Sub
            Exit For
        End If
    Next

    Dim NextRow As Range
    Set NextRow = Sheets("Data").Range("A2:L2").End(xlUp).Offset(1, 0)
    Set NextRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1,0)
    Sheets("Form").Range("C2,C4").Copy
    NextRow.PasteSpecial (xlValues)

    MsgBox ("Data added successfully!")

    Sheets("Form").Range("C2,C4").ClearContents

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
end sub

我已经编写了一个脚本，但这些列是垂直复制的，而不是水平复制。

Answer 1

你想从细胞C2和; C4最终在数据表中的1个空行

Private Sub SaveButton_Click()
    Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = Worksheets("Form").Range("C2")
    Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Offset(0, 1) = Worksheets("Form").Range("C4")
End Sub

Answer 2

确定。浏览Stackoverflow 3个小时后，我终于得到了我所需要的一切。我希望这会有所帮助。

整点是“Transpose：= True”。

Dim NextRow As Range
'find next clear row, set it as target'
Set NextRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

'copy the cell values from range'
Sheets("Form").Range("C2,C4").Copy

'paste values as horizontal line into target'
NextRow.PasteSpecial (xlValues), Transpose:=True

Excel VBA：从数据复制到工作表

2 个答案: