批量数据转移工作表

tinkou

本人是VBA小白请教各位VBA大神一个问题

想在按钮的点击或者双击事件中实现把1月份订单表中，状态是待安排和待审批状态的订单结转到2月份订单表中
1、通过【结转至下月】按钮后触发 删除本月表中审批状态是待审批和待安排的行
2、在时间中先进行提示，订单是否要结转到下月的提示框，是就执行，否就不执行

ykcbf1100

请上传附件，没有附件即便给你代码，你还要回来继续问的。

tinkou

ykcbf1100 发表于 2023-1-13 13:09
请上传附件，没有附件即便给你代码，你还要回来继续问的。

附件已经上传请大神赐教

ykcbf1100

tinkou 发表于 2023-1-13 14:09
附件已经上传请大神赐教

请看附件。

shiruiqiang

建议新建12张表，代表月份。直接输入月份进行处理

tinkou

ykcbf1100 发表于 2023-1-13 14:51
请看附件。

另外提个小小的需求，可以把1月份的连行都删除了，不仅仅是数据清楚掉

tinkou

ykcbf1100 发表于 2023-1-13 13:09
请上传附件，没有附件即便给你代码，你还要回来继续问的。

请大神直接在我的实际表格中操作吧，我捣鼓半天也没弄对

另外就是结转后最好连行都删除了，不仅仅是清楚数据

ykcbf1100

tinkou 发表于 2023-1-13 17:04
请大神直接在我的实际表格中操作吧，我捣鼓半天也没弄对

另外就是结转后最好连行都删除了，不仅仅是清 ...

下班了，要周一上班了。
如果到时没有解决，我再来搞一下吧。

tinkou

ykcbf1100 发表于 2023-1-13 17:06
下班了，要周一上班了。
如果到时没有解决，我再来搞一下吧。

好的，周一吧不急

tinkou

Sub ykcbf()    '//2023.1.13
    Dim arr, brr, crr, str
    str = [{"待安排","待审批"}]
    If MsgBox("确定要结转至下月吗？", vbYesNo) <> vbYes Then Exit Sub
    With Sheets("1")
        r = .Cells(.Rows.Count, "a").End(xlUp).Row
        c = .Cells(2, Columns.Count).End(xlToLeft).Column
        arr = .Range("a3", .Cells(r, c))
    End With
    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
    For i = 1 To UBound(arr)
        s = arr(i, 8)            '//条件区,这里可以多条件
        If s <> Empty Then
            For x = 1 To UBound(str)
                If InStr(str(x), s) Then
                    m = m + 1
                    For j = 1 To UBound(arr, 2)
                        brr(m, j) = arr(i, j)
                    Next
                    Exit For
                End If
            Next
        End If
    Next i
    For i = 1 To UBound(arr)
        s = arr(i, 8)            '//条件区,这里可以多条件
        If s <> Empty Then
            If InStr(str(1), s) = 0 And InStr(str(2), s) = 0 Then
                n = n + 1
                For j = 1 To UBound(arr, 2)
                    crr(n, j) = arr(i, j)
                Next
                Exit For
            End If
        End If
    Next i
    With Sheets("2")
        .Rows("3:22").ClearContents
        If m > 0 Then .[a3].Resize(m, UBound(brr, 2)) = brr
    End With
    MsgBox ("结转完成")
'    With Sheets("1")
'        .Rows("3:22").ClearContents
'        If n > 0 Then .[a3].Resize(n, UBound(crr, 2)) = crr
'    End With
End Sub

此过程只是实现了sheets("1")结转数据到sheets("2") 如果是1-12月份，12个工作表，怎么写通用的sub