Copy and Paste Filtered lists - Visible cells only

fddekker

Board Regular
Joined
Jun 30, 2008
Messages
63
I maintain an add-in with handy macros that we use at work. I would like to add one for copy and pasting filtered lists on the same sheet, e.g. a filtered list in a2:c9 should be copied to g2:i9. Only visible cells should be copied.
I know this can be accomplished by:
1: selecting the ‘paste-to’ range (e.g. g2:i9),
2: clicking on the visible cells only icon (added to the toolbar),
3: typing an equal sign in the top left cell of the area (e.g. g2)
4: navigating to the top left cell of ‘copy-from’ area (e.g. a2) and
5: hit ctrl-enter
to fill the original area

... however, explaining this to new Excel users over the phone is NOT the easiest thing. I would like the add-in to have a button on the ribbon, that when clicked, will only require the user to select the two ranges and the copying and pasting should be handled by vba. What would be the most effective way of accomplishing this?


Thanks in advance!

Francois
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,376
This will prompt the user to select the two copy-paste ranges and then do the work.

Code:
[color=darkblue]Sub[/color] Copy_Paste_Filtered_Cells()
    
    [color=darkblue]Dim[/color] rngSource [color=darkblue]As[/color] Range, rngDestination [color=darkblue]As[/color] Range
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
    Application.DisplayAlerts = [color=darkblue]False[/color]
    
    [color=darkblue]Set[/color] rngSource = Application.InputBox("Select the filtered range to copy. ", "Select Filtered Cells", Type:=8)
    [color=darkblue]If[/color] rngSource [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] [color=darkblue]GoTo[/color] Cleanup   [color=green]'User canceled[/color]
    
    [color=darkblue]Set[/color] rngDestination = Application.InputBox("Select the destination cell to paste to. ", "Select Paste Destination", Type:=8)
    [color=darkblue]If[/color] rngDestination [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] [color=darkblue]GoTo[/color] Cleanup  [color=green]'User canceled[/color]
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
    
    rngSource.Copy
    rngDestination(1).PasteSpecial xlPasteValues
    Application.CutCopyMode = [color=darkblue]False[/color]
    Application.Goto rngDestination
    
Cleanup:
    Application.DisplayAlerts = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Last edited:

fddekker

Board Regular
Joined
Jun 30, 2008
Messages
63
Alpha,
Thanks for your quick response, but the macro paste the data from the visible cells to all rows (which is why everyone is wondering why Microsoft does not allow for a paste special-> paste to visible cells only.) The data should only be copied to visible rows. Would adding a line in the macro to check for rows with height more than zero work?
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,376
I didn't pickup on the paste to visible cells.

Try this. It only test for hidden rows (not columns).

Code:
[color=darkblue]Sub[/color] Copy_Paste_Filtered_Cells()
    
    [color=darkblue]Dim[/color] rngSource [color=darkblue]As[/color] Range, rngDestination [color=darkblue]As[/color] Range, cell [color=darkblue]As[/color] Range, cc [color=darkblue]As[/color] [color=darkblue]Long[/color], i [color=darkblue]As[/color] Long
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
    Application.DisplayAlerts = [color=darkblue]False[/color]
    
    [color=darkblue]Set[/color] rngSource = Application.InputBox("Select the filtered range to copy. ", "Select Filtered Cells", Type:=8)
    [color=darkblue]If[/color] rngSource [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] Application.DisplayAlerts = True: [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]   [color=green]'User canceled[/color]
    
    [color=darkblue]Set[/color] rngDestination = Application.InputBox("Select the destination cell to paste to. ", "Select Paste Destination", Type:=8)
    [color=darkblue]If[/color] rngDestination [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] Application.DisplayAlerts = True: [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]  [color=green]'User canceled[/color]
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
    Application.DisplayAlerts = [color=darkblue]True[/color]
    
    cc = rngSource.Columns.Count
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] rngSource.Columns(1).SpecialCells(xlCellTypeVisible)
        [color=darkblue]Do[/color]
            i = i + 1
        [color=darkblue]Loop[/color] [color=darkblue]Until[/color] [color=darkblue]Not[/color] rngDestination(1).Offset(i).EntireRow.Hidden
        rngDestination(1).Offset(i).Resize(1, cc).Value = cell.Resize(1, cc).Value
    [color=darkblue]Next[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 

fddekker

Board Regular
Joined
Jun 30, 2008
Messages
63

ADVERTISEMENT

Works like a charm. Hope your princess kiss you soon Frog .... your a prince!
;)
 

Sayed Suhail

New Member
Joined
Apr 1, 2014
Messages
1
This worked like a miracle.. You made a humongous task so very simple... Thank you infinity times..


I didn't pickup on the paste to visible cells.

Try this. It only test for hidden rows (not columns).

Code:
[COLOR=darkblue]Sub[/COLOR] Copy_Paste_Filtered_Cells()
    
    [COLOR=darkblue]Dim[/COLOR] rngSource [COLOR=darkblue]As[/COLOR] Range, rngDestination [COLOR=darkblue]As[/COLOR] Range, cell [COLOR=darkblue]As[/COLOR] Range, cc [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], i [COLOR=darkblue]As[/COLOR] Long
    
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
    Application.DisplayAlerts = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] rngSource = Application.InputBox("Select the filtered range to copy. ", "Select Filtered Cells", Type:=8)
    [COLOR=darkblue]If[/COLOR] rngSource [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] Application.DisplayAlerts = True: [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]   [COLOR=green]'User canceled[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] rngDestination = Application.InputBox("Select the destination cell to paste to. ", "Select Paste Destination", Type:=8)
    [COLOR=darkblue]If[/COLOR] rngDestination [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] Application.DisplayAlerts = True: [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]  [COLOR=green]'User canceled[/COLOR]
    
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
    Application.DisplayAlerts = [COLOR=darkblue]True[/COLOR]
    
    cc = rngSource.Columns.Count
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] rngSource.Columns(1).SpecialCells(xlCellTypeVisible)
        [COLOR=darkblue]Do[/COLOR]
            i = i + 1
        [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]Until[/COLOR] [COLOR=darkblue]Not[/COLOR] rngDestination(1).Offset(i).EntireRow.Hidden
        rngDestination(1).Offset(i).Resize(1, cc).Value = cell.Resize(1, cc).Value
    [COLOR=darkblue]Next[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,376

ADVERTISEMENT

You're welcome and thanks for the feedback. Welcome to the forum and well done on searching for a solution first.
 

sdkravetz

New Member
Joined
Apr 14, 2014
Messages
2
This is working well for me but it seems to copy into the cells one row below what I select... am I doing something incorrectly?

note: I quoted the original post.... but I am actually using the correct Macro

This will prompt the user to select the two copy-paste ranges and then do the work.

Code:
[COLOR=darkblue]Sub[/COLOR] Copy_Paste_Filtered_Cells()
    
    [COLOR=darkblue]Dim[/COLOR] rngSource [COLOR=darkblue]As[/COLOR] Range, rngDestination [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
    Application.DisplayAlerts = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] rngSource = Application.InputBox("Select the filtered range to copy. ", "Select Filtered Cells", Type:=8)
    [COLOR=darkblue]If[/COLOR] rngSource [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]GoTo[/COLOR] Cleanup   [COLOR=green]'User canceled[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] rngDestination = Application.InputBox("Select the destination cell to paste to. ", "Select Paste Destination", Type:=8)
    [COLOR=darkblue]If[/COLOR] rngDestination [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]GoTo[/COLOR] Cleanup  [COLOR=green]'User canceled[/COLOR]
    
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
    
    rngSource.Copy
    rngDestination(1).PasteSpecial xlPasteValues
    Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
    Application.Goto rngDestination
    
Cleanup:
    Application.DisplayAlerts = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Last edited:

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,376
This is working well for me but it seems to copy into the cells one row below what I select... am I doing something incorrectly?

note: I quoted the original post.... but I am actually using the correct Macro

Try this.

Code:
[color=darkblue]Sub[/color] Copy_Paste_Filtered_Cells()
    
    [color=darkblue]Dim[/color] rngSource [color=darkblue]As[/color] Range, rngDestination [color=darkblue]As[/color] Range, cell [color=darkblue]As[/color] Range, cc [color=darkblue]As[/color] [color=darkblue]Long[/color], i [color=darkblue]As[/color] Long
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
    Application.DisplayAlerts = [color=darkblue]False[/color]
    
    [color=darkblue]Set[/color] rngSource = Application.InputBox("Select the filtered range to copy. ", "Select Filtered Cells", Type:=8)
    [color=darkblue]If[/color] rngSource [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] Application.DisplayAlerts = True: [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]   [color=green]'User canceled[/color]
    
    [color=darkblue]Set[/color] rngDestination = Application.InputBox("Select the destination cell to paste to. ", "Select Paste Destination", Type:=8)
    [color=darkblue]If[/color] rngDestination [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] Application.DisplayAlerts = True: [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]  [color=green]'User canceled[/color]
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
    Application.DisplayAlerts = [color=darkblue]True[/color]
    
    cc = rngSource.Columns.Count
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] rngSource.Columns(1).SpecialCells(xlCellTypeVisible)
        [color=darkblue]Do[/color] [color=darkblue]Until[/color] [color=darkblue]Not[/color] rngDestination(1).Offset(i).EntireRow.Hidden
            i = i + 1
        [color=darkblue]Loop[/color]
        rngDestination(1).Offset(i).Resize(1, cc).Value = cell.Resize(1, cc).Value
        i = i + 1
    [color=darkblue]Next[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 

Watch MrExcel Video

Forum statistics

Threads
1,122,233
Messages
5,594,964
Members
413,955
Latest member
FalcoDaz

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
Top