VBA code to move row to new spreadsheet

**cdurfey** · 06-10-2013, 06:16 PM

I want to have this code wopy over all rows with a "Y" in column K to a new spreadsheet. I have this so far but it will only bring over the first row if it is marked. I need to get this to move over all rows marked even if the first row is not marked. Any help is appreciated. Thanks

Code:

Dim colLetter As String, SavePath As String
    Dim lastValue As String
    Dim wb As Workbook
    Dim lng As Long
    Dim currentRow As Long
    colLetter = "K"
    SavePath = ThisWorkbook.Path
        With ThisWorkbook.Worksheets(1)
        .Cells.AutoFilter field:=.Cells(1, colLetter).Column, Criteria1:="Y"
        lng = .Cells(.Rows.Count, colLetter).End(xlUp).Row
        Set wb = Application.Workbooks.Add(xlWorksheet)
        .Rows(1 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
        .AutoFilterMode = False

**patel** · 06-10-2013, 07:45 PM

Code:

    .Rows(2 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
    .AutoFilterMode = False

**cdurfey** · 06-10-2013, 07:53 PM

That didn't work. All I am getting is a blank new workbook except when all of the "Y" are at the top in order. As soon as it hits an "N" it stops pulling over.

**Rick Rothstein** · 06-10-2013, 08:00 PM

Does this code do what you want (note that I removed some of the variables you declared which were not needed for this code, so if you need them later, you will have to Dim them again)...

Code:

Dim ColLetter As String, SavePath As String
Dim VisibleRows As Range, WS As Worksheet, wbOld As Workbook, wbNew As Workbook
ColLetter = "K"
Set wbOld = ThisWorkbook
Set wbNew = Application.Workbooks.Add(xlWorksheet)
Set WS = wbOld.Worksheets(1)
WS.Rows(1).Insert
WS.Cells.AutoFilter field:=WS.Cells(1, ColLetter).Column, Criteria1:="Y"
WS.AutoFilter.Range.SpecialCells(xlVisible).Copy wbNew.Worksheets(1).Range("A1")
WS.AutoFilterMode = False
WS.Rows(1).Delete

**cdurfey** · 06-10-2013, 10:24 PM

This works great except it does not bring over to column headers. Can you help with that? I have almost destroyed the macro. Thanks

**Rick Rothstein** · 06-10-2013, 10:36 PM

Originally Posted by cdurfey

This works great except it does not bring over to column headers. Can you help with that? I have almost destroyed the macro. Thanks

Not sure what you mean by "I have almost destroyed the macro", but this modified version of what I posted earlier should do what I think you want...

Code:

Dim ColLetter As String, SavePath As String
Dim VisibleRows As Range, WS As Worksheet, wbOld As Workbook, wbNew As Workbook
ColLetter = "K"
Set wbOld = ThisWorkbook
Set wbNew = Application.Workbooks.Add(xlWorksheet)
Set WS = wbOld.Worksheets(1)
WS.Cells.AutoFilter field:=WS.Cells(1, ColLetter).Column, Criteria1:="Y"
WS.AutoFilter.Range.SpecialCells(xlVisible).Copy wbNew.Worksheets(1).Range("A1")
WS.AutoFilterMode = False