Excelmacros从工作表中复制单元格数据并根据特定条件粘贴到另一个工作表上

我有两个名为“滑”和“备忘录”的工作表。 我想从Slip中复制数据，并通过按下滑动工作表中的命令button将其自动添加到Memo中。 如果单中的一个（或两个）项留空，将出现一个消息框，提示“所有项目必须填写”。 之后，填写的条目将不会被添加到备忘录中。

到目前为止，这是我有的代码：

Private Sub CommandButton1_Click() Dim SentDate As Date, Source As String, Subject As String, ReceivedBy As String, Mode As String Worksheets("Slip").Select SentDate = Range("F11") Source = Range("E1") Subject = Range("E2") ReceivedBy = Range("M34") Mode = Range("M35") Worksheets("Memo").Select Worksheets("Memo").Range("A3").Select If Worksheets("Memo").Range("A3").Offset(1, 0) <> "" Then Worksheets("Memo").Range("A3").End(xlDown).Select End If ActiveCell.Offset(1, 0).Select ActiveCell.Value = SentDate ActiveCell.Offset(0, 1).Select ActiveCell.Value = Source ActiveCell.Offset(0, 1).Select ActiveCell.Value = Subject ActiveCell.Offset(0, 1).Select ActiveCell.Value = ReceivedBy ActiveCell.Offset(0, 1).Select ActiveCell.Value = Mode Worksheets("Slip").Select If IsEmpty(Range("F11")) = True And IsEmpty(Range("E1").Value) = True And IsEmpty(Range("E2").Value) = True And IsEmpty(Range("M34").Value) = True And IsEmpty(Range("M35").Value) = True Then MsgBox "FORM is empty." ElseIf IsEmpty(Range("F11")) = True Or IsEmpty(Range("E1").Value) = True Or IsEmpty(Range("E2").Value) = True Or IsEmpty(Range("M34").Value) = True Or IsEmpty(Range("M35").Value) = True Then MsgBox "All entries must be filled." Else MsgBox "Successfully added to Memo" End If End Sub 

在消息框中写明“必须填写所有条目”后，应该填写什么条件？ ？

假设滑动看起来像这样：

A / B / C / d / E

date/来源/主题/收件人/模式

5月19日/ RD / Meeting / HR / Fax

5月20日/研讨会/会议/人力资源/传真

5月21日//会议/人力资源/传真

当我点击命令button时，应该说“所有条目都必须填写”，因为我在最后一行中留下了空白。 我将如何防止其余条目添加到备忘录，所以备忘录应该看起来像这样：

A / B / C / d / E

date/来源/主题/收件人/模式

5月19日/ RD / Meeting / HR / Fax

5月20日/研讨会/会议/人力资源/传真

它没有添加5月21日//会议/人力资源/传真，因为我留在滑动工作表的单元格空白。 这条件怎么样？

提前致谢

Answer 1

 I think the code would be like bellows, Sub test() Dim vAddress, strAddress As String Dim Ws As Worksheet, toWs As Worksheet Set Ws = Sheets("Slip") Set toWs = Sheets("Memo") vAddress = Array("f11", "e1", "q3", "e3", "m34", "m35", "f12", "a11", "c11", "g11", "h11") strAddress = Join(vAddress, ",") With Ws If IsEmpty(.Range("F11")) = True And IsEmpty(.Range("E1").Value) = True And _ IsEmpty(.Range("O3").Value) = True And IsEmpty(.Range("E3").Value) = True And _ IsEmpty(.Range("M34").Value) = True And IsEmpty(.Range("M35").Value) = True And _ IsEmpty(.Range("F12").Value) = True And IsEmpty(.Range("A11").Value) = True And _ IsEmpty(.Range("C11").Value) = True And IsEmpty(.Range("G11").Value) = True And _ IsEmpty(.Range("H11").Value) = True Then MsgBox "FORM is empty." ElseIf IsEmpty(.Range("F11")) = True Or IsEmpty(.Range("E1").Value) = True Or _ IsEmpty(.Range("O3").Value) = True Or IsEmpty(.Range("E3").Value) = True Or _ IsEmpty(.Range("M34").Value) = True Or IsEmpty(.Range("M35").Value) = True Or _ IsEmpty(.Range("F12").Value) = True Or IsEmpty(.Range("A11").Value) = True Or _ IsEmpty(.Range("C11").Value) = True Or IsEmpty(.Range("G11").Value) = True Or _ IsEmpty(.Range("H11").Value) = True Then MsgBox "All entries must be filled." Else toWs.Range(strAddress).Value = .Range(strAddress).Value MsgBox "Successfully added to Memo" End If End With End Sub 

代码可以像这样改变

  Sub test2() Dim vAddress, strAddress As String Dim Ws As Worksheet, toWs As Worksheet Dim rngDB As Range, n As Integer, k As Integer Set Ws = Sheets("Slip") Set toWs = Sheets("Memo") vAddress = Array("f11", "e1", "q3", "e3", "m34", "m35", "f12", "a11", "c11", "g11", "h11") strAddress = Join(vAddress, ",") With Ws Set rngDB = .Range(strAddress) n = rngDB.Cells.Count k = WorksheetFunction.CountA(rngDB) Select Case k Case 0 MsgBox "FORM is empty." Case Is < n MsgBox "All entries must be filled." Case Else toWs.Range(strAddress).Value = .Range(strAddress).Value MsgBox "Successfully added to Memo" End Select End With End Sub