What I am trying to accomplish is a dynamic macro that can be used in many different workbooks to achieve the following: I would like to have the user input a range that they would like to copy. This range will be filtered. Then I would like to have the user select range to paste the copied data. The range they will be pasting into is also filtered (may be different filters than where the data was copied from. IDEALLY the user would only select the top left cell of the range to paste onto (instead of having to select the entire thing).
The code below will copy the filtered data (visible cells only) as I would like.
Dim RangeCopy As Range
Dim RangeDest As Range
Set RangeCopy = Application.InputBox("Select a range to copy ", "Obtain Range Object", Type:=8)
MsgBox "The range you selected to copy is " & RangeCopy.Address
RangeCopy.Select
Selection.SpecialCells(xlCellTypeVisible).Select 'selects visible cells only from previously selected range
Selection.Copy
Pasting is of course the tricky part. I have found that I can manually "paste" successfully in the following manner:
Assume that the copied range is A1:A10 and the paste range is B10:B20
I can input the formula "= A1" into cell B10 ---> copy cell B10 ----> select the desired range to paste onto ----> use "Alt ;" shortcut ----> paste.
The following code attempts to automate this logic in VBA:
Dim RangeCopy As Range
Dim RangeDest As Range
Set RangeCopy = Application.InputBox("Select top cell of range to copy ", "Obtain Range Object", Type:=8)
MsgBox "The top cell of the range you would like to copy is " & RangeCopy.Address
Set RangeDest = Application.InputBox("Select the top of the range to paste onto ", "Obtain Range Object", Type:=8)
MsgBox "The top of the range you have selected to paste onto is " & RangeDest.Address
RangeDest.Formula = "=RangeCopy"
RangeDest.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
This presents two issues:
It pastes correctly onto only visible cells but it is currently entering "=CopyRange" as text into the range I want to paste onto (instead of a formula setting the "paste cell" equal to the "copy cell".
This code does not yet allow a user to select and exact range. It allows them to select a starting point but then will copy and paste to the end of the column being pasted onto. I need the user to be able to select a range and have yet to find a way to do so without errors occurring.
Searching online I have found other versions of "pasting onto visible cells macros". I tried to combine them with the first bit of code I shared in this post. This combination is shown below.
Sub Copy_Paste_Visible_Cells()
Dim RangeCopy As Range
Dim RangeDest As Range
Set RangeCopy = Application.InputBox("Select a range to copy ", "Obtain Range Object", Type:=8)
MsgBox "The range you selected to copy is " & RangeCopy.Address
RangeCopy.Select
Set RangeDest = Application.InputBox("Select range to paste onto ", "Obtain Range Object", Type:=8)
MsgBox "The range you have slected to paste onto is " & RangeDest.Address
Selection.SpecialCells(xlCellTypeVisible).Select 'selects visible cells only from previously selected range
Selection.Copy
Dim rng1 As Range
Dim rng2 As Range
For Each rng2 In RangeDest
If rng2.EntireRow.RowHeight > 0 Then
rng2.PasteSpecial
Set RangeDest = rng2.Offset(1).Resize(RangeDest.Rows.Count)
Exit For
End If
Next
Application.CutCopyMode = False
End Sub
This runs without error but the macro only pastes until it hits a hidden row. So if rows 1,2 3 and 6 are visible but 4 and 5 are hidden, the macro will paste onto 1,2 and 3 but not 4,5, or 6.
I have made several other attempts but these seem to be the most promising thus far. Any suggestions / help anyone can offer are greatly appreciated. The biggest key is to make this completely dynamic and as intuitive as possible for the user.
Thank you in advance !
I think the following code will do what you want:
Sub Copy_Paste_Visible_Cells()
'This subroutine only handles copying visible cells in a SINGLE COLUMN
Dim RangeCopy As Range
Dim RangeDest As Range
Dim rng1 As Range
Dim dstRow As Long
Set RangeCopy = Application.InputBox("Select a range to copy ", "Obtain Range Object", Type:=8)
MsgBox "The range you selected to copy is " & RangeCopy.Address
Set RangeDest = Application.InputBox("Select range to paste onto ", "Obtain Range Object", Type:=8)
MsgBox "The range you have selected to paste onto is " & RangeDest.Address
If RangeCopy.Cells.Count > 1 Then
If RangeDest.Cells.Count > 1 Then
If RangeCopy.SpecialCells(xlCellTypeVisible).Count <> RangeDest.SpecialCells(xlCellTypeVisible).Count Then
MsgBox "Data could not be copied"
Exit Sub
End If
End If
End If
If RangeCopy.Cells.Count = 1 Then
'Copying a single cell to one or more destination cells
For Each rng1 In RangeDest
If rng1.EntireRow.RowHeight > 0 Then
RangeCopy.Copy rng1
End If
Next
Else
'Copying a range of cells to a destination range
dstRow = 1
For Each rng1 In RangeCopy.SpecialCells(xlCellTypeVisible)
Do While RangeDest(dstRow).EntireRow.RowHeight = 0
dstRow = dstRow + 1
Loop
rng1.Copy RangeDest(dstRow)
dstRow = dstRow + 1
Next
End If
Application.CutCopyMode = False
End Sub
Notes:
It is intended to work only if you are working with a single column of data. i.e. don't try using a source or destination range spanning multiple columns.
A single source cell can be copied to a single destination cell (somewhat boring, but it would work), or to a range of destination cells.
A range of source cells can be copied to a single destination cell (in which case it will just continue to fill into whatever rows are visible below the selected cell), or to a range of destination cells providing that there are the same number of visible cells in the source as in the destination.