Copy filtered range to a dynamic range on same sheet

julhs

Active Member
Joined
Dec 3, 2018
Messages
471
Office Version
  1. 2010
Platform
  1. Windows
Thought this was going to be Oh so simple!!
Messing with this for some time, now can’t see the wood for the trees.

From a command button, I want to copy the "VISIBLE" filtered range to another location on the same sheet.
(If it makes a difference the destination range MAY be hidden due to the filter)
Have tested various different adaptations to no avail!!
So far I have this:-
VBA Code:
Sub CopyFilteredRng()
            'Application.ScreenUpdating = False
Dim sht As Worksheet
Dim rng As Range
Dim rngCopy As Range
Dim Frow As Long
Dim Lrow As Long

Set sht = ThisWorkbook.ActiveSheet
Set rng = Range("AK:AK").Find(what:="Sub Total", LookIn:=xlValues, LookAt:=xlWhole)
         Frow = rng.Row
         Lrow = sht.Cells(sht.Rows.Count, "AT").End(xlUp).Row
Set rngCopy = Range("AT" & Frow - 1 & ":AT" & Lrow + 1).SpecialCells(xlCellTypeVisible)
    rngCopy.Copy Range("AK" & Frow + 2)
            'Application.CutCopyMode = False
            'Application.ScreenUpdating = True
End Sub
But this ONLY copies the LAST cell of the "VISIBLE" filtered range and NOT ALL the "VISIBLE" filtered range to the destination range.
Any help is always gratefully received.
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
It is not clear what range you are trying to copy.
VBA Code:
Sub CopyFilteredRngDebug()
    'Application.ScreenUpdating = False
    Dim sht As Worksheet
    Dim rng As Range
    Dim rngCopy As Range
    Dim Frow As Long
    Dim Lrow As Long
    Dim Msg As String
    
    Set sht = ThisWorkbook.ActiveSheet
    Set rng = Range("AK:AK").Find(what:="Sub Total", LookIn:=xlValues, LookAt:=xlWhole)
    
    If rng Is Nothing Then
        MsgBox "String ""Sub Total"" not found - Abort macro", vbOKOnly Or vbCritical, Application.Name
        Exit Sub
    End If
    
    Frow = rng.Row
    
    Lrow = sht.Cells(sht.Rows.Count, "AT").End(xlUp).Row
    
    Set rngCopy = Range("AT" & Frow - 1 & ":AT" & Lrow + 1).SpecialCells(xlCellTypeVisible)
    
    Select Case MsgBox("This action will copy data from:" & vbCrLf _
            & "     " & rngCopy.Address(, , , 1) & vbCrLf & vbCrLf _
            & "to" & vbCrLf _
            & "     " & Range("AK" & Frow + 2).Address(, , , 1) & vbCrLf & vbCrLf _
            & "Continue?", vbYesNo, Application.Name)
            
        Case vbYes
            rngCopy.Copy Range("AK" & Frow + 2)
        Case vbNo
            
    End Select
    
    'Application.CutCopyMode = False
    'Application.ScreenUpdating = True
End Sub
 
Upvote 0
Many thanks riv01

I started out thinking I could simply use:
VBA Code:
Set rngCopy = Range("AT" & Frow - 3).SpecialCells(xlCellTypeVisible)
rngCopy.Copy Range("AK" & Frow + 2)
But I was getting:
VBA Code:
"Run-time error 1004, Cannot be pasted because Copy area and paste area are not same size and shape"
But my attempts to resize it failed, I THINK if I could get the resizing part I could use the above, what do you think??

However, the instant I ran your code (with a fresh head on) and your use of "Select Case MsgBox", I spotted my first mistake!!
VBA Code:
Set rngCopy = Range("AT" & Frow - 1 & ":AT" & Lrow + 1).SpecialCells(xlCellTypeVisible)
Should have read:
VBA Code:
Set rngCopy = Range("AT" & Frow - 3 & ":AT" & Lrow + 1).SpecialCells(xlCellTypeVisible)
Had neglected to take into account the effect of the filter hiding rows
Hence why BOTH are codes ONLY copied the last cell of the "VISIBLE" filtered range!
With some other testing, I also found "SpecialCells(xlCellTypeVisible)" was actually redundant when using:
VBA Code:
Set rngCopy = Range("AT" & Frow - 3 & ":AT" & Lrow + 1)

Many thanks for your help.
 
Upvote 0
You're welcome. For that situation it's often just a matter of getting your range definitions right.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

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