Macro cut based on criteria and paste to another sheet

[spill-the-beans]

Hi everyone,

I'm struggling with a simple macro, and some help would be greatly appreciated. I've tried recording a macro as a basis, but I just don't understand how to modify it to do what I want with the ranges. What I need is:

1. to select all the used range of data in sheet 1. This range will change over the different datasheets I need the macro for.
2. filter out all the values that do not equal 1 in column A. So now the only shown cells from A2 to the end are values of 1.
3. cut those rows only and paste them starting from A2 in Sheet 2.

This is the Macro that the recording gives me, but even that isn't right, because it cuts all the cells, even the ones that are not showing up when I filter out the cells that are not supposed to be in the cut. I thought autofilter would be the best option after searching the other questions, but maybe I'm not doing it right or a different approach would be better? Does anyone know how I could make this work?

Sub test17()
'
' test17 Macro
'


'
Sheets("Sheet1").Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$7").AutoFilter Field:=1, Criteria1:="1"
Rows("2:7").Select
Selection.Cut
Sheets("Sheet2").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown
End Sub

 

[JLGWhiz]

See if this does what you want.

Sub test17()
'
' test17 Macro
'

'
cnt = Application.CountIf(Sheets("Sheet1").Range("A:A"), "1")
With Sheets("Sheet1")
.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:="1"
Sheets("Sheet2").Range("A2").Resize(cnt, 1).EntireRow.Insert
.Range("A3", .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sheets("Sheet2").Range("A2").PasteSpecial xlPasteAll
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Application.CutCopyMode = False
End Sub