Copy the TOP 10 using a macro in an excel report

In some of my reports, I have a TOP 10 sheet about supporting groups, devices, SLA, conversation time, etc. To get it, I have to filter the data then copy the 10 first lines to this TOP 10 sheet.

macro excel macro excel

 

When I use the macro ?

To copy the 10 first rows from one sheet to another sheet.

 

How to create the macro ?

Read How to create, edit, hide and select a macro in an excel report

 

How to create the button to associate it with the macro ?

Read How to create a button and associated it to a macro in an excel report

 

How to use the macro ?

The sheet where you will paste the data should have no filtering.

 

How is the macro ?

Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.

For 1 filtered column:

Sub test()
Dim i As Long
Dim j As Range
Dim k As Range
' change A2 and A by your column
Set j = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(12)
For Each k In j
i = i + 1
' change 10 by the number of row you want to copy
If i = 10 Or i = j.Count Then Exit For
Next k
' change Sheet2 by your sheet name and A2 by the cell where you want to paste
Range(j(1), k).SpecialCells(12).Copy Sheets("Sheet2").Range("A2")
End Sub
macro excel

For 2 filtered columns:

Sub test()
' change
Dim i1 As Long, i2 As Long
Dim j1 As Range, j2 As Range
Dim k1 As Range, k2 As Range
' change A2 and A by your first column
Set j1 = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(12)
For Each k1 In j1
i1 = i1 + 1
' change 10 by the number of row you want to copy
If i1 = 10 Or i1 = j1.Count Then Exit For
Next k1
' change Sheet2 by your sheet name and A2 by the first cell where you want to paste
Range(j1(1), k1).SpecialCells(12).Copy Sheets("Sheet2").Range("A2")
' change B2 and B by your second column
Set j2 = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(12)
For Each k2 In j2
i2 = i2 + 1
' change 10 by the same number of row you want to copy
If i2 = 10 Or i2 = j2.Count Then Exit For
Next k2
' change Sheet2 by the same sheet name and B2 by the second cell where you want to paste
Range(j2(1), k2).SpecialCells(12).Copy Sheets("Sheet2").Range("B2")
End Sub
macro excel

Interesting Management