How Can copy and paste the value in filtered data using macro (Only visible cells)

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Here's general code
Code:
Sub FilterData()
    Dim rng As Range
    Dim rngVisible As Range
    Set rng = Range("A1:G1000")
    rng.AutoFilter Field:=1, Criteria1:=10
    On Error Resume Next
    Set rngVisible = GetFilterRange(rng).SpecialCells(xlCellTypeVisible)
    If Not rngVisible Is Nothing Then
        ' Process visible cells here
    End If
    On Error GoTo 0
End Sub

Private Function GetFilterRange(rng As Range) As Range
    With rng
        Set GetFilterRange = .Offset(1).Resize(.Rows.Count)
    End With
End Function
 
Upvote 0



  • Dim rVis As Range,rData As range
    Set rData= Sheet1.UsedRange 'change this to suit your needs
    Set rVis = rData.SpecialCells(xlCellTypeVisible)
    rVis.Copy 'rVis.Cut 'alternativeor
    activesheet or sheets("Asdasd").range("asdas").pastespecial

    or


    Sheet1.UsedRange.Copy Destination:=Sheet2.Range("A1")
 
Upvote 0
Thanks Sektor and sriram170

I modified and got this code its working nice.

Public Sub Copy_filtered_SpecialPaste()


On Error Resume Next
Application.DisplayAlerts = False


Set CopyRange = Application.InputBox("Select the filtered range to copy. ", "Select Filtered Cells", Type:=8)
If CopyRange Is Nothing Then GoTo Cleanup 'User canceled

If CopyRange Is Nothing Then
MsgBox "Nothing to paste"
Exit Sub
End If
If CopyRange.Columns.Count <> Selection.Columns.Count Then
MsgBox "Different number of columns selected"
Exit Sub
End If


Dim DestRange As Range
'Set DestRange = Selection
Set DestRange = Application.InputBox("Select the destination cell to paste to. ", "Select Paste Destination", Type:=8)
If DestRange Is Nothing Then GoTo Cleanup 'User canceled


On Error GoTo 0


Dim i As Integer, r As Integer, x As Integer
r = 1


For i = 1 To DestRange.Rows.Count
If DestRange.Rows(i).Height > 0 Then
For x = 1 To CopyRange.Columns.Count
DestRange.Cells(i, x).Value = CopyRange.Cells(r, x).Value
Next x
r = r + 1
End If
If r > CopyRange.Rows.Count Then Exit Sub
Next i




Cleanup:
Application.DisplayAlerts = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,144
Members
448,552
Latest member
WORKINGWITHNOLEADER

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