Vba 基于日期的宏复制和粘贴

我有一本手册，其中我试图记录自行车的库存和销售情况。我有当前库存、1月销售、2月销售、3月销售等的工作表，2013年12月销售额，总销售额

在当前库存中，我有A2中的自行车制造商，B2中的自行车型号，C2中的自行车类型，D2中的价格，E2中的序列号，F2中的销售日期，G2中的销售日期。在G列中，我有一个表单控件复选框

---

我想做的是，当我单击复选框时，自行车及其所有信息都会被复制并粘贴到相应的工作表中（例如，如果它在2013年8月13日售出，则会被排序到8月销售工作表和2013年总销售工作表）以及2013年总销售工作表中。此外，我希望选中的行将颜色从黑色更改为绿色。提前感谢您的帮助

确保您的复选框没有交叉到两个不同的行。一旦你确定了，我会这样做：

将同一宏指定给所有复选框

在宏中，我将添加以下代码：

Dim shp As Shape
Dim rng As Range
Dim currentRowNumber As Long

Set shp = ActiveSheet.Shapes(Application.Caller)
Set rng = shp.BottomRightCell
currentRowNumber = rng.Row

MsgBox "Currently, you are working on Row no " & currentRowNumber

一旦获得了行号，就可以轻松地找到值并编写相应的代码

希望这有帮助

谢谢，

---

V

首先考虑使用常规单元格而不是复选框（更简单、更好） 然后尝试下面的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim checkedMark As String
Dim currentRow As Integer, lastRow As Integer
checkedMark = "X"

If Target.Rows.Count <> 1 Then
    Exit Sub
End If
If TypeName(Target.Value) <> "String()" Then
    Exit Sub
End If
If UCase(Target.Value) <> checkedMark Then
    Exit Sub
End If
If Target.Columns <> 7 Then
    Exit Sub
End If


currentRow = Target.Row

Range(Cells(currentRow, 1), Cells(currentRow, 7)).Copy

With Sheets(BD_SHEET)
    lastRow = .Range("A100000").End(xlUp).Row
    Cells(lastRow + 1, 1).PasteSpecial xlPasteValues
End With

With Cells(currentRow, 1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 5296274
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End Sub

Private子工作表\u更改（ByVal目标作为范围）
Dim checkedMark作为字符串
Dim currentRow为整数，lastRow为整数
checkedMark=“X”
如果Target.Rows.Count为1，则
出口接头
如果结束
如果TypeName（Target.Value）“String（）”则
出口接头
如果结束
如果UCase（Target.Value）选中标记，则
出口接头
如果结束
如果目标为.7列，则
出口接头
如果结束
currentRow=Target.Row
范围（单元格（当前行，1），单元格（当前行，7））。复制
带图纸（BD_图纸）
lastRow=.Range（“A100000”）.End（xlUp）.Row
单元格（lastRow+1，1）。粘贴特殊XLPaste值
以
带单元格（currentRow，1）。内部
.Pattern=xlSolid
.PatternColorIndex=xlAutomatic
.Color=5296274
.TintAndShade=0
.PatternTintAndShade=0
以
端接头