- Excel Version
- 365
- 2021
- 2019
- 2016
- 2013
- 2011
- 2010
- 2007
Excel does not provide a direct method for copying and pasting from visible cells to visible cells.
So here's a method using VBA:
How it works:
1. Put the "Sub CopyVisibleToVisible1" code in a code module.
2. Run the code.
3. An input box will appear, asking you to select the range you want to copy. Select the range as required and click "OK."
4. Another input box will appear, asking you to select the range where you want to paste. Select only the first cell and click "OK."
5. Result:
The code:
If you plan to use this frequently in any open workbook, you can put the code in PERSONAL.xlsb and assign a toolbar button to it. Here's how:
1. Open the VBA window by pressing ALT+F11.
2. Open PERSONAL.xlsb.
3. In the module section, create a new module (e.g., Module1).
4. Paste the code into Module1.
5. Now, assign the code to a toolbar button. If you're not sure how to do this, you can follow the instructions on this link: add-macro-buttons-excel-ribbon-toolbar
6. Don't forget to save the VBAPROJECT (PERSONAL.XLSB).
The benefit of doing it this way:
Update: 2024-May-07
I've changed "Sub CopyVisibleToVisible1" to "Sub CopyVisibleToVisible2".
This new version includes two enhancements:
Here's the code:
Regards,
Akuini
So here's a method using VBA:
How it works:
1. Put the "Sub CopyVisibleToVisible1" code in a code module.
2. Run the code.
3. An input box will appear, asking you to select the range you want to copy. Select the range as required and click "OK."
4. Another input box will appear, asking you to select the range where you want to paste. Select only the first cell and click "OK."
5. Result:
The code:
VBA Code:
Sub CopyVisibleToVisible1()
'Use this for:
'Copy-paste(values only):
'from filtered range to filtered range
'from filtered range to unfiltered range
'from unfiltered range to filtered range
'Not work on hidden column
Dim rngA As Range
Dim rngB As Range
Dim r As Range
Dim Title As String
Dim ra As Long
Dim rc As Long
On Error GoTo skip:
Title = "Copy Visible To Visible"
Set rngA = Application.Selection
Set rngA = Application.InputBox("Select Range to Copy then click OK:", Title, rngA.Address, Type:=8)
Set rngB = Application.InputBox("Select Range to Paste (select the first cell only):", Title, Type:=8)
Set rngB = rngB.Cells(1, 1)
Application.ScreenUpdating = False
ra = rngA.Rows.Count
rc = rngA.Columns.Count
If ra = 1 Then rngB.Resize(, rc).Value = rngA.Value: Exit Sub
Set rngA = rngA.Cells(1, 1).Resize(ra, 1)
For Each r In rngA.SpecialCells(xlCellTypeVisible)
rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
Do
Set rngB = rngB.Offset(1, 0)
Loop Until rngB.EntireRow.Hidden = False
Next
Application.GoTo rngB
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
skip:
If err.Number <> 424 Then
MsgBox "Error found: " & err.Description
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
End SubIf you plan to use this frequently in any open workbook, you can put the code in PERSONAL.xlsb and assign a toolbar button to it. Here's how:
1. Open the VBA window by pressing ALT+F11.
2. Open PERSONAL.xlsb.
3. In the module section, create a new module (e.g., Module1).
4. Paste the code into Module1.
5. Now, assign the code to a toolbar button. If you're not sure how to do this, you can follow the instructions on this link: add-macro-buttons-excel-ribbon-toolbar
6. Don't forget to save the VBAPROJECT (PERSONAL.XLSB).
The benefit of doing it this way:
- The macro is accessible in any open workbook and is easy to access, i.e. through a ribbon button. So, it feels like a native Excel feature.
- You don’t need to put the macro on all your workbooks, just on PERSONAL.xlsb.
Update: 2024-May-07
I've changed "Sub CopyVisibleToVisible1" to "Sub CopyVisibleToVisible2".
This new version includes two enhancements:
- Users can now select a single cell value and paste it into multiple cells within a filtered range.
- The code is faster now as it loops through 'Areas' instead of 'Cells' when the copy-range and paste-range have the same structure of visible cells. This is particularly beneficial for large datasets.
Here's the code:
VBA Code:
Sub CopyVisibleToVisible2()
'Author: Akuini, Indonesia, 2024-May-06
'Use this for:
'Copy-paste(values only):
'from filtered range to filtered range
'from filtered range to unfiltered range
'from unfiltered range to filtered range
'Not work on hidden column
'This new version includes two enhancements:
' 1. Users can now select a single cell value and paste it into multiple cells within a filtered range.
' 2. The code is faster now as it loops through 'Areas' instead of 'Cells' when the copy-range and paste-range have the same structure of visible cells.
' This is particularly beneficial for large datasets.
Dim rngA As Range
Dim rngB As Range, rngBB As Range
Dim r As Range
Dim Title As String, txA As String, txB As String
Dim ra As Long, i As Long
Dim rc As Long, xCol As Long, a1 As Long, a2 As Long, h As Long
Dim Flag As Boolean
On Error GoTo skip:
Title = "Copy Visible To Visible"
Set rngA = Application.Selection
Set rngA = Application.InputBox("Select Range to Copy then click OK:", Title, rngA.Address, Type:=8)
'if copy-range is a single cell and needs to be pasted into multiple cells (in filtered range)
If rngA.Cells.CountLarge = 1 Then
Set rngB = Application.InputBox("Select Range (multiple cells) to Paste:", Title, Type:=8)
rngB.SpecialCells(xlCellTypeVisible).Value = rngA.Value
Exit Sub
End If
Set rngB = Application.InputBox("Select Range to Paste (select the first cell only):", Title, Type:=8)
Set rngB = rngB.Cells(1, 1)
Application.ScreenUpdating = False
ra = rngA.Rows.Count
rc = rngA.Columns.Count
If ra = 1 Then rngB.Resize(, rc).Value = rngA.Value: Exit Sub
If Not Intersect(rngA.Cells(1).EntireRow, rngB) Is Nothing Then 'if the copied range is pasted into the same row in the same sheet
'therefore the code can loop each visible areas, which is faster than looping each cell.
xCol = rngB.Column
For Each r In rngA.SpecialCells(xlCellTypeVisible).Areas
ActiveSheet.Cells(r.Row, xCol).Resize(r.Rows.Count, r.Columns.Count).Value = r.Value
Next
Else 'if the copied range is not pasted into the same row then
'check if copy-range & paste-range has the same structure of visible cells
Set rngB = rngB.Resize(ra, rc)
a1 = rngA.Columns(1).SpecialCells(xlCellTypeVisible).Areas.Count
a2 = rngB.Columns(1).SpecialCells(xlCellTypeVisible).Areas.Count
If a1 = a2 Then
For h = 1 To a1
'If any corresponding area in both ranges has a different number of rows, it means they have a different structure of visible cells.
If rngA.Columns(1).SpecialCells(xlCellTypeVisible).Areas(h).Cells.CountLarge <> rngB.Columns(1).SpecialCells(xlCellTypeVisible).Areas(h).Cells.CountLarge Then
Flag = True
Exit For
End If
Next
Else
Flag = True
End If
If Flag = True Then 'if copy-range & paste-range have different structure of visible cells, then the code needs to loop through each cells in both range
'this would slow down the process on large data
Set rngA = rngA.Cells(1, 1).Resize(ra, 1)
For Each r In rngA.SpecialCells(xlCellTypeVisible)
rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
Do
Set rngB = rngB.Offset(1, 0)
Loop Until rngB.EntireRow.Hidden = False
Next
Else 'If the copy-range and paste-range have the same structure of visible cells, then the code can loop through each visible area
'This will speed up the process.
For i = 1 To rngA.Columns(1).SpecialCells(xlCellTypeVisible).Areas.Count
rngB.SpecialCells(xlCellTypeVisible).Areas(i).Value = rngA.SpecialCells(xlCellTypeVisible).Areas(i).Value
Next
End If
End If
Application.GoTo rngB
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
skip:
If Err.Number <> 424 Then
MsgBox "Error found: " & Err.Description
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
End SubRegards,
Akuini
