Excel Vba - Copy row if value in cell is greater than - excel

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