Excel VBA，将数据从一个工作表复制并粘贴到另一个工作表，然后删除复制数据源

我很难创建一个宏，该宏将一行数据从一个工作表复制到另一个工作表，然后立即删除复制的数据源，并向上移动下面的行以清除剩余的空白/空行。此工作簿的上下文是一个请求跟踪程序，一旦请求有完成日期，在一段时间（30天）后，该请求将复制到“历史请求”表中。紧接着，活动页面上最初复制的数据将被删除，其他所有内容将被“上移”，以清除留下的空白。这是我已经开发的，当然有一些帮助。。。如果有人能帮忙，我们将不胜感激

Public Sub DataBackup()
Dim RowDate
Dim CurrentDate
Dim Interval
Dim CurrentAddress
Dim ValueCellRange As Range
Dim ValueCell As Range
Dim ws As Worksheet

'Interval set to an appropriate number of days
Interval = 30
CurrentDate = Now()

For Each ws In Worksheets
    Set ValueCellRange = ws.Range("U3:U130")
    For Each ValueCell In ValueCellRange
        If ValueCell.Value <> "" Then
            If CurrentDate - ValueCell.Value >= Interval Then

                Rows(ActiveCell.Row).Select

                Sheets("Historical Requests").Select
                ActiveSheet.Paste

                ValueCell.EntireRow.ClearContents
            End If
        End If
    Next ValueCell
Next ws

'Clear variable value for next initialization
Set ValueCell = Nothing



End Sub

公共子数据备份（）
暗行日期
当前日期
暗间隔
暗电流地址
Dim ValueCellRange作为范围
Dim ValueCell As范围
将ws设置为工作表
'间隔设置为适当的天数
间隔=30
CurrentDate=Now（）
对于工作表中的每个ws
设置值CellRange=ws.Range（“U3:U130”）
对于ValueCellRange中的每个ValueCell
如果ValueCell.Value为“”，则
如果CurrentDate-ValueCell.Value>=间隔，则
行（ActiveCell.Row）。选择
工作表（“历史请求”）。选择
活动表。粘贴
ValueCell.EntireRow.ClearContents
如果结束
如果结束
下一个值单元格
下一个ws
'为下一次初始化清除变量值
Set ValueCell=无
端接头

你确实把工作放进去了。正如BruceWayne所说，您的代码不错，但可以使用较少的选择和较少的激活。您无需选择或激活工作表或范围即可使用它。这里的代码效率更高一些，我认为其他许多代码可以使它更高效

顺便说一句，删除行时，请尝试始终从下至上。并确保列“H”的格式为日期，否则这不是我的工作

Sub copyCut()
Dim ws_DATA As Worksheet, ws_HISTORY As Worksheet
Dim lastRowHISTORY As Long

Set ws_DATA = Sheet3'   Change this sheet to match your correct one
Set ws_HISTORY = Worksheets(4)' Change this sheet to match your correct one


For i = 130 To 3 Step -1
    On Error Resume Next
    lastRowHISTORY = ws_HISTORY.Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row + 1
    If Err.Number = 91 Then lastRowHISTORY = 1
    On Error GoTo 0

    If Now - DateValue(ws_DATA.Range("U" & i).Value) > 29 Then
        ws_DATA.Range("U" & i).EntireRow.Copy Destination:=ws_HISTORY.Range("A" & lastRowHISTORY)
        ws_DATA.Range("U" & i).EntireRow.Delete
    End If
Next i
Set ws_DATA = Nothing
Set ws_HISTORY = Nothing

End Sub

---

要循环浏览所有四个工作表，只需在脚本中放入一个“for 1=n To 4”循环。我能预见的唯一问题是，如果所有四个页面都有不同的行数。如果它们不是全部130，那么很容易修复。请告诉我。只需要代码就可以找到每张工作表上最后使用的行

    Sub copyCut()
    Dim ws_DATA As Worksheet, ws_HISTORY As Worksheet
    Dim lastRowHISTORY As Long

    Set ws_DATA = Sheet3'   Change this sheet to match your correct one
    Set ws_HISTORY = Worksheets(4)' Change this sheet to match your correct one

    For n = 1 to 4

    Select Case n
         Case 1
             Set ws_DATA = Worksheets("Sheet1")' change these to your sheet names
         Case 2 
             Set ws_DATA = Worksheets("Sheet2")
         Case 3 
             Set ws_DATA = Worksheets("Sheet3")
         Case 4 
             Set ws_DATA = Worksheets("Sheet4")

    End Select 

    For i = 130 To 3 Step -1
        On Error Resume Next
        lastRowHISTORY = ws_HISTORY.Cells.Find(What:="*", _
                        After:=Range("A1"), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row + 1
        If Err.Number = 91 Then lastRowHISTORY = 1
        On Error GoTo 0

        If Now - DateValue(ws_DATA.Range("U" & i).Value) > 29 Then
            ws_DATA.Range("U" & i).EntireRow.Copy Destination:=ws_HISTORY.Range("A" & lastRowHISTORY)
            ws_DATA.Range("U" & i).EntireRow.Delete
        End If
    Next i


Next n

Set ws_DATA = Nothing
Set ws_HISTORY = Nothing

End Sub

---

这是所有的代码，还是你被困在如何做它的一部分？此外，我强烈建议查看[如何避免使用

。选择/

。激活

](https://stackoverflow.com/questions/10714251/)因为它将有助于减少代码，并更直接地处理数据。另外，您应该将工作表放在行（…）之前。选择`否则它只会选择/使用活动工作表上的行。您好，John，谢谢您。然而，我觉得我在细节上有点害羞。我的工作簿中有四个主要工作表包含数据或“请求”。然后，一旦请求的完成日期超过30天，他们的数据将被复制到“历史请求”中。例如，假设我的一个主要工作表上有一个从一个地区到另一个地区的请求。它老化了30天。现在我需要复制并粘贴到“历史请求”工作表中。数据传输后，必须将其原始来源从其原始工作表中删除。传输完成后，必须立即用其下方的其他条目填充剩余的空白，以避免出现空白条目。我甚至不知道从何处开始使用此代码……代码行“If Now-DateValue（ws_DATA.Range（“U”&I.Value）>29 Then”返回了一个不匹配错误。“运行时错误13”。这部分代码是否会检查列“U”中的每一行，并对照间隔29检查日期？由于某些请求可能无法完成，这些行中的某些行中可能还有空值。请尝试删除datevalue和括号中的值