Excel Vba - 如果单元格中的值大于，则复制行

Question

I've got this table full of data. And column K in each row contains a number. So basically what I'm trying to do is move that entire row, if the data in that column is greater than 9, over to sheet2.

How can this be achieved? I've already created actual tables in the sheets, called Table1 and Table2.

This is what I've managed to put together so far. I've looked at autofilter, but I can't understand squat of what's happening in there. So this I get!

Sub MoveData()

    Dim i As Range
    Dim num As Integer
     num = 1
    For Each i In Range("K10:K1000")
        If i.Value > 9 Then
            i.Select
            ActiveCell.Rows("1:1").EntireRow.Select
            Selection.Copy

            Sheets("Sheet2").Range("A65000").End(xlUp).Offset(num, 0).PasteSpecial
            ActiveCell.Rows.Delete
            num = num + 1

        End If
    Next i
End Sub

This kinda works so far. But I can't manage to paste the row to the next blank row in sheet2. I tried doing that num = num + 1 thing, but I guess that's way off?

Answer 1

Is this what you are trying? ( TRIED AND TESTED )

Option Explicit

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim rRange As Range

    Dim lastRowWsO As Long

    Set wsI = Sheets("sheet1")

    '~~> Assuming that the Header is in K10
    Set rRange = wsI.Range("K10:K1000")

    Set wsO = Sheets("sheet2")

    '~~> Get next empty cell in Sheet2
    lastRowWsO = wsO.Range("A" & Rows.Count).End(xlUp).Row + 1

    With wsI
        '~~> Remove Auto Filter if any
        .AutoFilterMode = False

        With rRange
            '~~> Set the Filter
            .AutoFilter Field:=1, Criteria1:=">=9"

            '~~> Temporarirly hide the unwanted rows
            wsI.Rows("1:9").EntireRow.Hidden = True
            wsI.Rows("1001:" & Rows.Count).EntireRow.Hidden = True

            '~~> Copy the Filtered rows
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            wsO.Rows(lastRowWsO)

            '~~> Delete The filtered rows
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        '~~> Unhide the rows
        .Rows("1:9").EntireRow.Hidden = False
        .Rows("1001:" & Rows.Count).EntireRow.Hidden = False

        '~~> Remove Auto Filter
        .AutoFilterMode = False
    End With
End Sub

NOTE : I have not included any error handling. I would recommend you to include one in the final code

FOLLOWUP

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim rRange As Range

    Dim lastRowWsI As Long, lastRowWsO As Long

    Set wsI = Sheets("Risikoanalyse")

    '~~> Assuming that the Header is in K10
    Set rRange = wsI.Range("K9:K1000")

    lastRowWsI = wsI.Cells.Find(What:="*", _
                After:=wsI.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row


    Set wsO = Sheets("SJA utarbeides")

    '~~> Get next empty cell in Sheet2
    lastRowWsO = wsO.Cells.Find(What:="*", _
                After:=wsO.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row + 1

    With wsI
        With .ListObjects("TableRisikoAnalyse")
            '~~> Set the Filter
            .Range.AutoFilter Field:=11, Criteria1:=">=9"

            '~~> Temporarirly hide the unwanted rows
            wsI.Rows("1:8").EntireRow.Hidden = True
            wsI.Rows(lastRowWsI & ":" & Rows.Count).EntireRow.Hidden = True

            '~~> Copy the Filtered rows
            wsI.Range(Replace(wsI.Range("K9").Offset(1, 0).SpecialCells(xlCellTypeVisible).Address, "$9:$9,", "")).EntireRow.Copy _
            wsO.Rows(lastRowWsO)

            '~~> Clear The filtered rows
            wsI.Range(Replace(wsI.Range("K9").Offset(1, 0).SpecialCells(xlCellTypeVisible).Address, "$9:$9,", "")).Clear

            .Range.AutoFilter Field:=11

            '~~> Sort the table so that blank cells are pushed down                
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("TableRisikoAnalyse[[ ]]"), SortOn:=xlSortOnValues, Order _
            :=xlAscending, DataOption:=xlSortTextAsNumbers
            With .Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With

        '~~> Unhide the rows
        .Rows("1:8").EntireRow.Hidden = False
        .Rows(lastRowWsI & ":" & Rows.Count).EntireRow.Hidden = False

        '~~> Remove Auto Filter
        .AutoFilterMode = False
    End With
End Sub