存档行第5个vba代码

Question

我有一个小项目，当工作表1的行大于5时，将数据从工作表1移动到工作表2。

例如：

表1包含如下数据：

和表2的数据如下：

当第6行或大于第1张的行有数据时。它会将数据从表1的第6行移动到第2页的第一行。

这样的事情： 当工作表1的第6行有数据时（第6行的数据为999）：

它会在第一行剪切999到第2张：

我用SheetChange事件尝试了这个。这是我的代码

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS1 As Excel.Worksheet
Dim WS2 As Excel.Worksheet
Set WS1 = Workbooks("Book1.xlsm").Worksheets("Sheet1")
Set WS2 = Workbooks("Book1.xlsm").Worksheets("Sheet2")

MaxRow = 5

'find last row of sheet 1 and sheet 2
WS1LastRow = WS1.Cells(WS1.Rows.Count, "A").End(xlUp).Row
WS2LastRow = WS2.Cells(WS2.Rows.Count, "A").End(xlUp).Row

If (Target.Row > MaxRow) Then
    NumberOfRowGreater5 = WS1LastRow - MaxRow
    'move data of sheet 2 down
    WS2.Range("A" & 2 + NumberOfRowGreater5 & ":" & "A" & WS2LastRow + NumberOfRowGreater5).Value = WS2.Range("A2:A" & WS2LastRow).Value
    WS2.Range("A2:A" & 2 + NumberOfRowGreater5 - 1).Clear

    'Cut data from row 5th of sheet 1 to sheet 2
     WS2.Range("A2:A" & 2 + NumberOfRowGreater5 - 1).Value = WS1.Range("A" & MaxRow + 1 & ":" & "A" & WS1LastRow).Value
     WS1.Range("A" & MaxRow + 1 & ":" & "A" & WS1LastRow).Clear
End If

End Sub

但有时它会将数据移动错误，有时会重复数据，有时会丢失数据。我不知道在没有重复或丢失数据的情况下是否有更好的方法来移动数据。我考虑使用vba的Range.Cut函数，但结果相同。

Answer 1

你可以试试这个评论代码

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MaxRow As Long, ws1LastRow As Long, NumberOfRowGreater5 As Long
    Dim WS2 As Worksheet

    Set WS2 = Workbooks("Book1.xlsm").Worksheets("Sheet2")
    MaxRow = 5

    ws1LastRow = Cells(Rows.count, "A").End(xlUp).row 'find column A last not empty row of current sheet (you're in its own change event handler!)
    If (ws1LastRow > MaxRow) Then '<--| if some values beyond column A row 5
        NumberOfRowGreater5 = ws1LastRow - MaxRow '<--| store rows number to be taken off current sheet and inserted in "Ssheet2"
        Application.EnableEvents = False '<--| disable events not to trigger this event handele in a possibly infinite loop
        On Error GoTo exitsub '<--| be sure to exit this sub properly
        With WS2 '<--| reference "Sheet2"
            With .Range("A2", .Cells(Rows.count, "A").End(xlUp)) '<--| reference its column A cells from row2 down to last not empty one
                .Offset(NumberOfRowGreater5).Value = .Value '<--| shift values down 'NumberOfRowGreater5' rows
            End With
        End With
        With Range("A6").Resize(NumberOfRowGreater5) '<--| reference current sheeet column A range to be "shifted" (i.e. from row 6 down to last not empty one)
            WS2.Range("A2").Resize(NumberOfRowGreater5).Value = .Value '<--| copy its values to "Sheet2" range from row 2 down 'NumberOfRowGreater5' rows
            .ClearContents '<--| clear its content . Here you'd trigger Worksheet_Change() event again hadn't you disabled events
        End With
exitsub:
        Application.EnableEvents = True '<--| enable events back
    End If
End Sub

实际上，您可以避免Application.EnableEvents设置和随后的错误处理，因为在Worksheet_Change() .ClearContents语句之后第二次触发If (ws1LastRow > MaxRow) Then检查将返回False < / p>

但要保持良好的编码习惯