Copy certain lines from active sheet and paste it to book 1 and 2

[zone709]

HI,

Trying to do something like this


If "Yards" is in column A then copy and paste all the rows to a new book

If "Grass" is in Column A then copy and paste all the rows to a new book.

The only thing is Grass or Yard wont start in Column A till row 2. Row 1 has my headers and I need to take always row 1 to any new book.

 

[Trebor76]

Hi zone709,

Try this:

Option Explicit
Sub Macro1()

    Dim ws As Worksheet
    Dim lngLastRow As Long
    Dim lngLastCol As Long
    Dim varMyFilterItem As Variant
    Dim rngFiltered As Range
    Dim wb As Workbook
    
    Application.ScreenUpdating = False
    
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Sheet name with data. Change to suit if necessary.

    lngLastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lngLastCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    For Each varMyFilterItem In Array("Yards", "Grass")
        ws.AutoFilterMode = False 'Remove all filters
        Range(ws.Cells(1, 1), ws.Cells(lngLastRow, lngLastCol)).AutoFilter Field:=1, Criteria1:=CStr(varMyFilterItem), Operator:=xlFilterValues
        Set rngFiltered = Range(ws.Cells(1, 1), ws.Cells(lngLastRow, lngLastCol)).SpecialCells(xlCellTypeVisible)
        If Not rngFiltered Is Nothing Then
            Set wb = Workbooks.Add(1) 'Create a new workbook with just one tab. Change to suit.
            rngFiltered.Copy wb.Worksheets(1).Range("A1") 'Paste the data into the first (only) sheet in the workbook to cell A1. Change to suit.
            Set rngFiltered = Nothing
            Set wb = Nothing
        End If
    Next varMyFilterItem
    
    Set ws = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert

 

[My Aswer Is This]

Try this:

Sub Copy_Me()
'Modified  8/26/2019  2:11:14 AM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim c As Long
Dim WB As String
Dim WS As String
WB = ThisWorkbook.Name
WS = ActiveSheet.Name
c = 1
lastrow = Workbooks(WB).Sheets(WS).Cells(Rows.Count, c).End(xlUp).Row
With Workbooks(WB).Sheets(WS).Cells(1, c).Resize(lastrow)
    .AutoFilter 1, "Yards"
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
    Workbooks.Add
    Workbooks(WB).Sheets(WS).Rows(1).Copy Rows(1)
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(1).Rows(2)
        
    Else
        MsgBox "No value  Yards  Found"
    End If
    .AutoFilter
End With
With Workbooks(WB).Sheets(WS).Cells(1, c).Resize(lastrow)
    .AutoFilter 1, "Grass"
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
    Workbooks.Add
    Workbooks(WB).Sheets(WS).Rows(1).Copy Rows(1)
        
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(1).Rows(2)
        
    Else
        MsgBox "No value Grass Found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[zone709]

Hi guys thanks for response, but both are not working. Trebor i do get 2 sheets that open up, but it doesnt paste from orginal sheet. Wierd on what happens. The Anwser your's debugs right in this spot.

[LEFT][COLOR=#333333][FONT=monospace]lastrow = Workbooks(WB).Sheets(WS).Cells(Rows.Count, c).End(xlUp).Row[/FONT][/COLOR][/LEFT]

I showed below again what I am trying to do

Original and active sheet below

Excel 2016 (Windows) 32 bit

	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​	K​
1​	Name	Hours	Last Name	First Name	month	jkajd	sfdksj
2​	Grass	20​	Espos	Mike	Feb	1​	1​
3​	Grass	21​	Espos	Mike	Mar	1​	1​
4​	Grass	23​	Espos	Mike	Apr	1​	1​
5​	Grass	24​	Espos	Mike	May	1​	1​
6​	Yards	24​	Harry	John	Jan	1​	1​
7​	Yards	24​	Harry	John	Feb	1​	1​
8​	Yards	30​	Harry	John	Mar	1​	1​
9​	Yards	30​	Harry	John	Apr	1​	1​
10​	Yards	30​	Harry	John	May	1​	1​
11​	Yards	30​	Harry	John	June	1​	1​
12​

Sheet: LCP

Results for 2 different sheets below

For grass:
Excel 2016 (Windows) 32 bit

	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​	K​	L​	M​
1​	Name	Hours	Last Name	First Name	month	jkajd	sfdksj
2​	Grass	20​	Espos	Mike	Feb	1​	1​
3​	Grass	21​	Espos	Mike	Mar	1​	1​
4​	Grass	23​	Espos	Mike	Apr	1​	1​
5​	Grass	24​	Espos	Mike	May	1​	1​

Sheet: LCP

For Yards:

Excel 2016 (Windows) 32 bit

	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​	K​	L​	M​
1​	Name	Hours	Last Name	First Name	month	jkajd	sfdksj
6​	Yards	24​	Harry	John	Jan	1​	1​
7​	Yards	24​	Harry	John	Feb	1​	1​
8​	Yards	30​	Harry	John	Mar	1​	1​
9​	Yards	30​	Harry	John	Apr	1​	1​
10​	Yards	30​	Harry	John	May	1​	1​
11​	Yards	30​	Harry	John	June	1​	1​

Sheet: LCP

So end result I have now two different books. One with the grass data and one with the Yards data.

 

[zone709]

Trebor i think i see whats going on with your code. I think it searches threw all my modules of codes and is picking up other stuff to do and pasting it on the new sheets. Instead of looking at just the Activesheet i am using.

 

[My Aswer Is This]

I'm not sure what code your referring to. My code worked for me. When more then one poster provides code it is good to specify which code is working or not working. The code I provided creates two new workbooks as per your request if I understood your request properly.

If you still need help let me know.

I test all my scripts and it worked for me.

You said:

So end result I have now two different books. One with the grass data and one with the Yards data.​

Your image seemed to show the results you wanted and which my code did.

So if this is not what you wanted please explain.

 

[zone709]

Hi thanks for the response(My Answer Is This) Your code debugs on me at this spot.

[LEFT][COLOR=#333333][FONT=monospace]lastrow = Workbooks(WB).Sheets(WS).Cells(Rows.Count, c).End(xlUp).Row[/FONT][/COLOR][/LEFT]

So it doesn't work because nothing happens. Trying to figure out why it breaks at this spot.

 

[My Aswer Is This]

I have no ideal. When scripts work for me but not you I have no answer.

I wish I had a better answer.

You did not provide the name of your Workbook or the sheet name. So I had to write the script where the code has to get the Workbook and sheet name.

Maybe if you provided these details I could write the script another way.

 

[My Aswer Is This]

In post 4 you show what appears to be two different sheets but both with the same name

Sheet LCP

 

[zone709]

Yeah i did it for an example to show how I was splitting it, but thse results should be in 2 different books.. The Worbook's name is LCP yes (active book). Whatever it does after that i dont care. It can go into book1 and book2 in any way. Just looking to split the active sheet (LCP) into 2 more sheets with split data.