Macro always skips row 1 and partner macro only works when new sheet created is sheet1

[wittonlin]

These two macros are always ran together. (the ones together in the first window.)

This one selects all the chosen rows with certain states using column 7 and moves them all to a new sheet1.
MoveNonStatesToSheet1

This, of course, moves the rows back to the same workbook and appends to first empty row.
MoveFromSheet1ToCurrentLeadFileUsingandDelete3


Somewhere between these two macros there's a problem with skipping row 1 in this process. It's no big deal until row 1 has a state like AZ, that I'm trying to move and it gets stuck in row 1

The other issue is unlike the 2nd macro that appears to not necessarily look for just sheet1, I think it just looks for last sheet used and gets the data from there. I need the first macro to do something similar. If when a new sheet is created, and sheet1 was used already during multiple saves, it won't matter. I need it to use whatever the new sheet is 1, 2, 3 probably not greater than that. The 2nd macro shouldn't be affected if it's not sheet1 where the rows it needs to get are at, if I'm reading right.

Sub MoveNonStatesToSheet1()

Sheets.Add after:=Sheets(Sheets.count) ' worksheet creation

Dim r As Range, filtr As Range
With Worksheets("CurrentLeadFileUsing")
Set r = .Range("A1").CurrentRegion

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="KY"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="TN"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="KS"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="OK"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="NE"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="AK"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="AL"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="AZ"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

Call SortEntireWorksheetByStateNOSaveAs

End With

End Sub




Sub MoveFromSheet1ToCurrentLeadFileUsingandDelete3()

For j = 2 To Sheets.count ' from sheet 2 to last sheet

Sheets(j).Activate ' make the sheet active

Range("A1").Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select 'select all data

' copy cells selected in the new sheet on last line

Selection.Copy Destination:=Workbooks("CurrentLeadFileUsing.csv").Sheets(1).Range("A65536").End(xlUp)(2)

Application.DisplayAlerts = False
Sheets("Sheet1").Delete

Next

End Sub

This call is to reorder the rows, by state again, that were not moved to the bottom of the file.

Sub SortEntireWorksheetByStateNOSaveAs()

'use the keyword "Selection" for the currently selected range
Cells.Select
With ActiveSheet.Sort
    .SortFields.Clear
    'the key you want to use is the column to sort on. I used column 1, which is "A", column "B" is 2, etc
    .SortFields.Add Key:=Selection.Columns(7), Order:=xlAscending
    .SetRange Selection
    .Apply
    
End With
    
End Sub

Thank you for anyone able to help!
Mark

 

[wittonlin]

I can see the data shift down one row as soon as I run the macro, then the blank row 1 goes away. No matter what I can't get it to include row 1 in the process!

This seems right, at least starting at cell A1!
Set r = .Range("A1").CurrentRegion

This line I'm sure has to do with sheet1 where the data is going.
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial

That leaves this line and I've tried every combination I can think of!
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)

 

[wittonlin]

this place sure isn't like it used to be. This has always been one of the best boards on the net

 

[MARK858]

That leaves this line and I've tried every combination I can think of!
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)

The Offset(1,0) moves the whole range down 1 row.
The Resize(r.Rows.count - 1) in the original code removes the last row from the range after the move down so the last row in the range is still the same, so if you just want the whole range it is just...

Set filtr = r.SpecialCells(xlCellTypeVisible)

The reason you move it down when using autofilter is to remove the header (which you should always have) when copying using autofilter.