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

Z

zone709

Well-known Member
Joined
Mar 1, 2016
Messages
2,125
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
Hi zone709,

Try this:

Code: 
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
 
Upvote 0
Try this:
Code: 
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
 
Upvote 0
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.

Code: 
[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
[Table="width:, class:head"][tr=bgcolor:#888888][th] [/th][th]
A​
[/th][th]
B​
[/th][th]
C​
[/th][th]
D​
[/th][th]
E​
[/th][th]
F​
[/th][th]
G​
[/th][th]
H​
[/th][th]
I​
[/th][th]
J​
[/th][th]
K​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
1​
[/td][td]Name[/td][td]Hours[/td][td]Last Name[/td][td]First Name[/td][td]month[/td][td]jkajd[/td][td]sfdksj[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
2​
[/td][td]Grass[/td][td]
20​
[/td][td]Espos[/td][td]Mike[/td][td]Feb[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
3​
[/td][td]Grass[/td][td]
21​
[/td][td]Espos[/td][td]Mike[/td][td]Mar[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
4​
[/td][td]Grass[/td][td]
23​
[/td][td]Espos[/td][td]Mike[/td][td]Apr[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
5​
[/td][td]Grass[/td][td]
24​
[/td][td]Espos[/td][td]Mike[/td][td]May[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
6​
[/td][td]Yards[/td][td]
24​
[/td][td]Harry[/td][td]John[/td][td]Jan[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
7​
[/td][td]Yards[/td][td]
24​
[/td][td]Harry[/td][td]John[/td][td]Feb[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
8​
[/td][td]Yards[/td][td]
30​
[/td][td]Harry[/td][td]John[/td][td]Mar[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
9​
[/td][td]Yards[/td][td]
30​
[/td][td]Harry[/td][td]John[/td][td]Apr[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
10​
[/td][td]Yards[/td][td]
30​
[/td][td]Harry[/td][td]John[/td][td]May[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
11​
[/td][td]Yards[/td][td]
30​
[/td][td]Harry[/td][td]John[/td][td]June[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
12​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: LCP[/td][/tr][/table]

Results for 2 different sheets below

For grass:
Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#888888][th] [/th][th]
A​
[/th][th]
B​
[/th][th]
C​
[/th][th]
D​
[/th][th]
E​
[/th][th]
F​
[/th][th]
G​
[/th][th]
H​
[/th][th]
I​
[/th][th]
J​
[/th][th]
K​
[/th][th]
L​
[/th][th]
M​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
1​
[/td][td]Name[/td][td]Hours[/td][td]Last Name[/td][td]First Name[/td][td]month[/td][td]jkajd[/td][td]sfdksj[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
2​
[/td][td]Grass[/td][td]
20​
[/td][td]Espos[/td][td]Mike[/td][td]Feb[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
3​
[/td][td]Grass[/td][td]
21​
[/td][td]Espos[/td][td]Mike[/td][td]Mar[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
4​
[/td][td]Grass[/td][td]
23​
[/td][td]Espos[/td][td]Mike[/td][td]Apr[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
5​
[/td][td]Grass[/td][td]
24​
[/td][td]Espos[/td][td]Mike[/td][td]May[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: LCP[/td][/tr][/table]

For Yards:

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#888888][th] [/th][th]
A​
[/th][th]
B​
[/th][th]
C​
[/th][th]
D​
[/th][th]
E​
[/th][th]
F​
[/th][th]
G​
[/th][th]
H​
[/th][th]
I​
[/th][th]
J​
[/th][th]
K​
[/th][th]
L​
[/th][th]
M​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
1​
[/td][td]Name[/td][td]Hours[/td][td]Last Name[/td][td]First Name[/td][td]month[/td][td]jkajd[/td][td]sfdksj[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
6​
[/td][td]Yards[/td][td]
24​
[/td][td]Harry[/td][td]John[/td][td]Jan[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
7​
[/td][td]Yards[/td][td]
24​
[/td][td]Harry[/td][td]John[/td][td]Feb[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
8​
[/td][td]Yards[/td][td]
30​
[/td][td]Harry[/td][td]John[/td][td]Mar[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
9​
[/td][td]Yards[/td][td]
30​
[/td][td]Harry[/td][td]John[/td][td]Apr[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
10​
[/td][td]Yards[/td][td]
30​
[/td][td]Harry[/td][td]John[/td][td]May[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
11​
[/td][td]Yards[/td][td]
30​
[/td][td]Harry[/td][td]John[/td][td]June[/td][td]
1​
[/td][td]
1​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: LCP[/td][/tr][/table]

So end result I have now two different books. One with the grass data and one with the Yards data.
 
Upvote 0
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.
 
Upvote 0
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.
 
Last edited:
Upvote 0
Hi thanks for the response(My Answer Is This) Your code debugs on me at this spot.

Code: 
[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.
 
Upvote 0
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.
 
Last edited:
Upvote 0
In post 4 you show what appears to be two different sheets but both with the same name

Sheet LCP
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
vba to find specific text in a column and then when found copy all the rows above it
Replies
1
Views
119
mumps
mumps
S
  • Solved
Copying columns of data to second worksheet based on input on third worksheet
Replies
2
Views
168
StuartE
S
R
  • Question Question
Merge Excel Multiple Sheets from a single work book to one sheet.
2
Replies
11
Views
767
rtr1811
R
I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
277
Peter_SSs
Peter_SSs
R
  • Solved
Add Formula to Same Cell as Hard Typed Number.
Replies
5
Views
252
Fluff
Fluff

Forum statistics

Threads
1,223,897
Messages
6,175,271
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top