Copy and Paste Filtered lists - Visible cells only

F

fddekker

Board Regular
Joined
Jun 30, 2008
Messages
86
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
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:
Upvote 0
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?
 
Upvote 0
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]
 
Upvote 0
Works like a charm. Hope your princess kiss you soon Frog .... your a prince!
;)
 
Upvote 0
This worked like a miracle.. You made a humongous task so very simple... Thank you infinity times..


AlphaFrog said:
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]
Click to expand...
 
Upvote 0
You're welcome and thanks for the feedback. Welcome to the forum and well done on searching for a solution first.
 
Upvote 0
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

AlphaFrog said:
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]
Click to expand...
 
Last edited:
Upvote 0
sdkravetz said:
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
Click to expand...

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

Similar threads

T
  • Question
Multiple filters on filtered list
Replies
1
Views
204
Cubist
C
M
  • Question
Creating and emailing Excel sheet with only visible data
Replies
0
Views
165
mecerrato
M
M
  • Question
Excel script Cope paste with filters
Replies
0
Views
193
michalina
M
O
  • Solved
Limit filter list to unique values
2
Replies
11
Views
275
smozgur
smozgur
B
  • Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
477
Alex Blakenburg
A

Forum statistics

Threads
1,214,782
Messages
6,121,532
Members
449,037
Latest member
tmmotairi

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