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

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
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

J
  • Solved
Search/Filter a Spreadsheet by User Entered Value
Replies
3
Views
117
jbennett01
J
T
  • Question Question
Multiple filters on filtered list
Replies
1
Views
603
Cubist
Cubist
J
  • Question Question
Filtering Results in List Box
Replies
2
Views
115
JohnS_323
J
N
  • Question Question
Excel VBA copy data to a worksheet in list form
Replies
0
Views
82
NewbieExcel123
N
M
  • Question Question
Creating and emailing Excel sheet with only visible data
Replies
0
Views
499
mecerrato
M

Forum statistics

Threads
1,223,630
Messages
6,173,454
Members
452,514
Latest member
cjkelly15

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