将数据移动到另一个表中。

王子宇

请高手帮忙，将未处理清单中M列中已填写日期的数据移动到已处理清单中去。快速处理。

wodewan

Option Explicit

Sub test()
Dim i&, n&, j&, r&
Dim arr(), brr(), crr, rng As Range
Application.ScreenUpdating = False
crr = Sheet2.Range("a1").CurrentRegion.Offset(1)

For i = 1 To UBound(crr)
  If crr(i, 13) <> "" Then
    n = n + 1
    ReDim Preserve arr(1 To n)
    arr(n) = i
  End If
Next
If n = 0 Then
MsgBox "未发现代处理的数据!", 64
Exit Sub
End If

ReDim brr(1 To n, 1 To UBound(crr, 2))
For i = 1 To UBound(arr)
    For j = 1 To UBound(crr, 2)
    brr(i, j) = crr(arr(i), j)
    Next
Next

With Sheet2
For i = 1 To UBound(arr)
    If rng Is Nothing Then
    Set rng = .Rows(arr(i) + 1)
    Else
    Set rng = Union(rng, .Rows(arr(i) + 1))
    End If
Next
rng.Delete
End With

With Sheet3
    r = .Range("a" & Rows.Count).End(xlUp).Row + 1
    .Rows(r).Interior.Color = vbRed
    .Range("a" & r).Resize(UBound(brr), UBound(brr, 2)) = brr
    .Select
End With

MsgBox "共移动" & n & "条记录"
End Sub

wodewan

附件供参考，代码被审核了。

清风竹-

请看附件。

王子宇

清风竹- 发表于 2019-11-5 20:34
请看附件。

非常感谢，我要就是这功能，只是当没有数据时点击会报错

王子宇

wodewan 发表于 2019-11-5 18:39
Option Explicit

Sub test()

感谢你，功能没得问题，