VBA/Macro to copy and paste rows into different sheets

S

srose88

New Member
Joined
Mar 15, 2013
Messages
16
Hi,

I have the data set below which is a report extract (rerun and pasted over weekly) in sheet "Data Sheet", I need a VBA or Macro to extract all the data from Won rows into a different sheet in the sheet named "Won". I also need it to pull the data on Open rows into the sheet named "Pipeline".

On the Won and Pipeline sheets the row data needs to be pasted from cell B8 across/down.

Is it also possible to add buttons for each of these macros/executions onto the won and pipeline sheets to automate the process?

Thanks in advance.


Status
Date openedDate closedNameMilestoneNameCompetitorsDescriptionStatusConfidence% completeProductsValueAssigned toStart dateEnd dateCPMImpressionsInternal IO#Agency Group
Open16/08/2013 09:15Lead–1200First contactAAAAAAAAAAAAOpen10%0AAAA£50,000AAAA01/01/2014 00:0030/03/2014 23:00AAAAAAAA
Won17/04/2013 13:3217/04/2013 13:40Lead–1114First contactAAAAAAAAAAAAWon100%0AAAA£600AAAA22/04/2013 00:0028/04/2013 00:00£2.00300000AAAAAAAA
Won17/04/2013 13:3717/04/2013 13:40Lead–1116First contact
AAAAAAAAAAAAWon100%0AAAA£600AAAA06/05/2013 00:0012/05/2013 00:00£2.00300000AAAAAAAA
Lost20/05/2013 09:3727/06/2013 10:55Lead–1141First contactAAAAAAAAAAAALost10%0AAAA£12,000AAAA01/08/2013 00:0031/08/2013 00:00AAAAAAAA
Cancelled08/04/2013 09:5717/06/2013 16:42Lead–1101IOAAAAAAAAAAAACancelled10%75AAAA£5,000AAAA01/07/2013 00:0031/08/2013 00:00AAAAAAAA

<colgroup><col><col span="2"><col span="2"><col><col><col><col><col><col><col><col><col><col span="2"><col span="2"><col><col></colgroup><tbody>
</tbody>
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
I have some code which does a similar job just change the names of the keys words that it is looking for, and the column to search, the range and the paste location. Just copy it into VB to see the comments more clearly.

Code: 
Sub Cut4() 'The code is set so that the rows are insterted to row2 so you can add headings to row 1'
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row


Sheets("Sheet1").Select 'Selects the sheet that will be searched'


With Range("A1:M800") 'Sets the search range'
.AutoFilter field:=7, Criteria1:="Line1" 'Searches for the cell with the word Line1 & cuts that row'
Intersect(Range("A2:M" & Rows.Count), .SpecialCells(xlCellTypeVisible).EntireRow).Copy _
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'Copy Location'
Range("A2:M" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With


With Range("A1:M800") 'Sets the search range'
.AutoFilter field:=7, Criteria1:="Line2" 'Line2'
Intersect(Range("A2:M" & Rows.Count), .SpecialCells(xlCellTypeVisible).EntireRow).Copy _
Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'Copy Location'
Range("A2:M" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With


End Sub

And you can just paste this into a module and to run it just click the developer tab and macro's and run it from there, but if you want a button I can try add that for you.
 
Upvote 0
Wasn't to sure if I knew how to get the code working with the buttons so I did it myself and got it working.

Go to Developer Tab > Instert > Active X Controls > Option button

Add two of them and then double click one of them and add this code to it

Code: 
Private Sub OptionButton1_Click()


 If OptionButton1 = True Then
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row


    Sheets("Sheet1").Select 'Selects the sheet that will be searched'


        With Range("A1:M800") 'Sets the search range'
            .AutoFilter field:=7, Criteria1:="Line1" 'Searches for the cell with the word Line1 & cuts that row'
            Intersect(Range("A2:M" & Rows.Count), .SpecialCells(xlCellTypeVisible).EntireRow).Copy _
            Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'Copy Location'
            Range("A2:M" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter
        End With
End If


End Sub


Private Sub OptionButton2_Click()


 If OptionButton2 = True Then
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row


    Sheets("Sheet1").Select 'Selects the sheet that will be searched'


        With Range("A1:M800") 'Sets the search range'
            .AutoFilter field:=7, Criteria1:="Line2" 'Searches for the cell with the word Line1 & cuts that row'
            Intersect(Range("A2:M" & Rows.Count), .SpecialCells(xlCellTypeVisible).EntireRow).Copy _
            Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'Copy Location'
            Range("A2:M" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter
        End With
End If


End Sub

As I mentioned before you will need to change the search work, Range, column to look it, paste locations etc to fit your worksheet

Hope this helps
 
Upvote 0
great thanks, however these seems to have cut and pasted my data opposed to copy paste - am i missing something?
 
Upvote 0
Yup that was my bad, need to get my eyes checked :D

Try this

Code: 
Private Sub OptionButton1_Click()


 If OptionButton1 = True Then
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row


    Sheets("Sheet1").Select 'Selects the sheet that will be searched'


        With Range("A1:M800")
        .AutoFilter field:=7, Criteria1:="=*Line*"
        Intersect(Range("A2:M" & Rows.Count), .SpecialCells(xlCellTypeVisible).EntireRow).Copy _
        Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With
    Selection.AutoFilter
    
End If


End Sub


Private Sub OptionButton2_Click()


 If OptionButton2 = True Then
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row


    Sheets("Sheet1").Select 'Selects the sheet that will be searched'
    
    With Range("A1:M800")
    .AutoFilter field:=7, Criteria1:="=*Line*"
    Intersect(Range("A2:M" & Rows.Count), .SpecialCells(xlCellTypeVisible).EntireRow).Copy _
    Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End With
    Selection.AutoFilter


End If


End Sub
 
Upvote 0
put a command button on sheet 1 and assign this macro

Code: 
Private Sub CommandButton1_Click()
'Sheet Won
      Dim Rng As Range
      
With Sheets("Data Sheet")
  .AutoFilterMode = False
  .Range("A1:D1").AutoFilter Field:=1, Criteria1:="Won"
    Set Rng = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Resize(, 20).SpecialCells(xlCellTypeVisible)
    Rng.Copy Sheets("Won").Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With
End Sub

and another command button on your pipeline sheet assign this macro

Code: 
Private Sub CommandButton1_Click()
'Sheet Pipeline
      Dim Rng As Range
      
With Sheets("Data Sheet")
  .AutoFilterMode = False
  .Range("A1:D1").AutoFilter Field:=1, Criteria1:="Open"
    Set Rng = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Resize(, 20).SpecialCells(xlCellTypeVisible)
    Rng.Copy Sheets("Pipeline").Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With
End Sub
 
Last edited:
Upvote 0
Fantastic thank you.
One final request...is it possible to reorder and only select certain columns from the data sheet?
For example:

Current order/columns:

ABCDEFGHIJKLMNOPQRST
StatusDate openedDate closedNameMilestoneNameCompetitorsDescriptionStatusConfidence% completeProductsValueAssigned toStart dateEnd dateCPMImpressionsInternal IO#Agency Group

<tbody>
</tbody>

Remapped on the new sheets to columns as per below:

BCDEFGHIJKLMN
Date closedInternal IO#Assigned toName (col F in original)Agency GroupCompetitorsDescriptionProductsImpressionsStart dateEnd dateCPMValue

<tbody>
</tbody>

Possible?

many (many) thanks in advance
 
Upvote 0
hippiehacker said:
how do you get the data into your datasheet possible to rearrange before copying to other sheets?.
Click to expand...

Not really as its a data export that will just be pasted into the excel doc. I could always run another macro to reorder. Ideally if anyone knows how to solve this i'd be interested to know for future ref.
thanks
 
Upvote 0
create another Sheet named Sort and run this code this will Sort Data from Data Sheet as you require it you just need to change the previous posted filter macros to filter in the right columns

Code: 
Sub test()
Dim Ar As Variant
Dim i As Integer
Dim lc As Integer
Dim fnd As Integer

Ar = Array("Date closed", "Internal IO#", "Assigned to", "Name", "Agency Group", "Competitors", "Description", "Products", "Impressions", "Start date", "End date", "CPM", "Value")

    For i = 0 To UBound(Ar)
        fnd = Sheets("Data Sheet").Rows(1).Find(Ar(i)).Column
        Sheets("Data Sheet").Columns(fnd).Copy Sheets("Sort").Cells(1, i + 1)
    Next i

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Excel Pivot table Time Values is not populating same as Source Sheet
Replies
1
Views
308
awoohaw
awoohaw
AOB
  • Question
Calculate the "true" duration of up/down times accounting for gaps and overlaps
Replies
1
Views
262
AOB
AOB
J
  • Solved
Excel "Strava Best Effort" Calculation
2
Replies
13
Views
400
felixstraube
F
M
  • Solved
Returning results based on multiple criteria
Replies
5
Views
271
DanteAmor
DanteAmor
M
  • Question
Complexed Time Difference Formula
2
Replies
17
Views
1K
mahmed1
M

Forum statistics

Threads
1,214,790
Messages
6,121,608
Members
449,038
Latest member
apwr

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