VBA/Macro to copy and paste rows into different sheets

[srose88]

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 opened

Date closed

Name

Milestone

Name

Competitors

Description

Status

Confidence

% complete

Products

Value

Assigned to

Start date

End date

CPM

Impressions

Internal IO#

Agency Group

Open

16/08/2013 09:15

Lead–1200

First contact

AAAA

AAAA

AAAA

Open

10%

0

AAAA

£50,000

AAAA

01/01/2014 00:00

30/03/2014 23:00

AAAA

AAAA

Won

17/04/2013 13:32

17/04/2013 13:40

Lead–1114

First contact

AAAA

AAAA

AAAA

Won

100%

0

AAAA

£600

AAAA

22/04/2013 00:00

28/04/2013 00:00

£2.00

300000

AAAA

AAAA

Won

17/04/2013 13:37

17/04/2013 13:40

Lead–1116

First contact

AAAA

AAAA

AAAA

Won

100%

0

AAAA

£600

AAAA

06/05/2013 00:00

12/05/2013 00:00

£2.00

300000

AAAA

AAAA

Lost

20/05/2013 09:37

27/06/2013 10:55

Lead–1141

First contact

AAAA

AAAA

AAAA

Lost

10%

0

AAAA

£12,000

AAAA

01/08/2013 00:00

31/08/2013 00:00

AAAA

AAAA

Cancelled

08/04/2013 09:57

17/06/2013 16:42

Lead–1101

IO

AAAA

AAAA

AAAA

Cancelled

10%

75

AAAA

£5,000

AAAA

01/07/2013 00:00

31/08/2013 00:00

AAAA

AAAA

<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>

 

[hippiehacker]

recognized an error as no status will be in the Sort sheet I have fixed this the sort macro

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

Ar = Array("Status", "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

The Code for Sheet Won

Private Sub CommandButton1_Click()
'Sheet Won
Dim rngFiltered As Range
Dim rngTarget As Range
      Dim Rng As Range
      
With Sheets("Sort")
  .AutoFilterMode = False
  .Range("A1:D1").AutoFilter
  .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

Code for Sheet Pipeline

Private Sub CommandButton1_Click()
'Sheet Pipeline
Dim rngFiltered As Range
Dim rngTarget As Range
      Dim Rng As Range
      
With Sheets("Sort")
  .AutoFilterMode = False
  .Range("A1:D1").AutoFilter
  .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