Copying Constant Data and Pasting to Only Visible Cells

Bkisley

Board Regular
Joined
Jan 5, 2017
Messages
100
I have a set of date - lets say Cells A1:A300
I need to transfer this over to a different file/template that I can not change. This template has a row then two hidden rows then a row then two hidden rows....etc.
So if I select A1:A300 and copy then paste it over to this template, it pastes information in the hidden rows.

How can I copy the entire data section and then paste in my template to only the visible (unhidden) cells??

I hope this is possible!
Thanks
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
You can try this:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] CopyVisibleToVisible1()
[I][COLOR=seagreen]'Copy paste(value):[/COLOR][/I]
[I][COLOR=seagreen]'from filtered to filtered range[/COLOR][/I]
[I][COLOR=seagreen]'from filtered to unfiltered range[/COLOR][/I]
[I][COLOR=seagreen]'from unfiltered to filtered range[/COLOR][/I]
[I][COLOR=seagreen]'Not work on hidden column[/COLOR][/I]
[I][COLOR=seagreen]'Can't copy-paste to another workbook[/COLOR][/I]

    [COLOR=Royalblue]Dim[/COLOR] rngA [COLOR=Royalblue]As[/COLOR] Range
    [COLOR=Royalblue]Dim[/COLOR] rngB [COLOR=Royalblue]As[/COLOR] Range
    [COLOR=Royalblue]Dim[/COLOR] r [COLOR=Royalblue]As[/COLOR] Range
    [COLOR=Royalblue]Dim[/COLOR] Title [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] ra [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] rc [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
    
    [COLOR=Royalblue]On[/COLOR] [COLOR=Royalblue]Error[/COLOR] [COLOR=Royalblue]GoTo[/COLOR] [COLOR=Royalblue]skip[/COLOR]:
    
    Title = [COLOR=brown]"Copy Visible To Visible"[/COLOR]
    [COLOR=Royalblue]Set[/COLOR] rngA = Application.Selection
    [COLOR=Royalblue]Set[/COLOR] rngA = Application.InputBox([COLOR=brown]"Select Range to Copy :"[/COLOR], Title, rngA.Address, [COLOR=Royalblue]Type[/COLOR]:=[COLOR=crimson]8[/COLOR])
    
    [COLOR=Royalblue]Set[/COLOR] rngB = Application.InputBox([COLOR=brown]"Paste Range (select the first cell only):"[/COLOR], Title, [COLOR=Royalblue]Type[/COLOR]:=[COLOR=crimson]8[/COLOR])
    [COLOR=Royalblue]Set[/COLOR] rngB = rngB.Cells([COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR])
    Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]

    ra = rngA.Rows.count
    rc = rngA.Columns.count
    [COLOR=Royalblue]Set[/COLOR] rngA = rngA.Cells([COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR]).Resize(ra, [COLOR=crimson]1[/COLOR])
    
    [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] r [COLOR=Royalblue]In[/COLOR] rngA.SpecialCells(xlCellTypeVisible)
      rngB.Resize([COLOR=crimson]1[/COLOR], rc).Value = r.Resize([COLOR=crimson]1[/COLOR], rc).Value
        [COLOR=Royalblue]Do[/COLOR]
          [COLOR=Royalblue]Set[/COLOR] rngB = rngB.Offset([COLOR=crimson]1[/COLOR], [COLOR=crimson]0[/COLOR])
        [COLOR=Royalblue]Loop[/COLOR] [COLOR=Royalblue]Until[/COLOR] rngB.RowHeight <> [COLOR=crimson]0[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]
    
    Application.Goto rngB
    Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
    Application.CutCopyMode = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]Sub[/COLOR]
[COLOR=Royalblue]skip[/COLOR]:
    [COLOR=Royalblue]If[/COLOR] err.Number <> [COLOR=crimson]424[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        MsgBox [COLOR=brown]"Error found: "[/COLOR] & err.Description
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
    Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
    Application.CutCopyMode = [COLOR=Royalblue]False[/COLOR]


[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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