Copying range without excluding autofiltered rows

0
votes

I am trying to copy a specific range from a protected sheet that has an autofilter with a few rows in the range filtered out. When using the following code, only the visible rows in the range get copied:

origWB.Sheets("some data").Range("D3:LB77").Copy
targetWS.Cells(3, 4).PasteSpecial xlValues

As I said, the sheet is protected (and for various reasons I can't unprotect it within the macro), so I can't use commands that would normally solve the problem like this:

origWB.Sheets("some data").Range("D3:LB77").EntireRow.Hidden = False

I've been able to cancel the filter:

origWB.Sheets("some data").AutoFilterMode = False

This enables me to copy all the lines but then I can't figure out how to get the filter working again (as I need to leave the sheet exactly the way I found it) without getting blocked by the sheet protection.

I would appreciate either a solution that temporarily removes the filter and resumes it after the copy, or a solution that enables me to copy all the range including the hidden/filtered rows without messing with the filter itself.

2
excelvbaautofilter
stackoverflow.com/questions/9489126/… – Tim Williams
I actually know the filter settings and don't need to capture them before running - the problem is I can't reapply the filter because I'm not allowed to remove the sheet protection. So the question is if there's a way to reactivate the filter in spite of the protection – eli-k
Save a copy of the file using SaveCopyAs, remove the filter and copy the range, then you can delete the copy of the file. – Tim Williams
That's a neat idea, thanks! I guess I could do this (and will, if nothing else comes up) but still - isn't there a more direct approach? something like range(...).copyAll without fussing with the autofilter at all? – eli-k
Your restriction on not unprotecting the sheet seems a little arbitrary - why not do that? – Tim Williams

2 Answers

1
votes

I am not sure if it is possible to copy invisible cells by "copy". As far as i know it is not possible.

However, it is possible to read each cell value / styling properties cell by cell.

It should do the work fine for smaller ranges, but it is really slow when we have more cells (it trying to read each value instead copying entire range and this is time consuming).

Option Explicit

Sub code()
'a little performence boost
Application.ScreenUpdating = False

Dim source_cols As Integer
Dim source_rows As Integer
Dim source_range As Range
Set source_range = Sheets("SourceSheet").Range("a1:LB77")
Dim destination_range As Range
Set destination_range = Sheets("targetSheet").Range("a1")
source_cols = source_range.Columns.Count
source_rows = source_range.Rows.Count


Dim col As Integer
Dim row As Integer
For row = 1 To source_rows
    For col = 1 To source_cols
        'Copy value
        destination_range.Offset(row - 1, col - 1).Value = source_range.Cells(row, col).Value
        
        'Copy some extra styling if needed
        destination_range.Offset(row - 1, col - 1).Interior.Color = source_range.Cells(row, col).Interior.Color
        destination_range.Offset(row - 1, col - 1).Font.Color = source_range.Cells(row, col).Font.Color
        destination_range.Offset(row - 1, col - 1).Font.Bold = source_range.Cells(row, col).Font.Bold
    
    Next col
Next row

Application.ScreenUpdating = True
End Sub

However, I am recommending copy file (or worksheet at least) to remove filter, copy entire range and delete file/sheet that you just copied.

1
votes

The following code adds a new worksheet and copies the entire range to the new spreadsheet where you can then copy and paste where you like

I have directed the copy to be below the existing filtered data but this can be redirected

Sub CopyFilteredData()
    Dim wsDst As Worksheet, tblDst As Range
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wsSrc As Worksheet: Set wsSrc = wb.Worksheets("some data")
    Dim tblSrc As Range: Set tblSrc = wsSrc.Range("D3:LB77")
    
    Set wsDst = wb.Worksheets.Add
    Set tblDst = wsDst.Range(tblSrc.Address)
    tblDst = "='" & wsSrc.Name & "'!" & tblSrc.Address
    tblDst.Copy
    tblSrc.Offset(tblSrc.Rows.Count + 1, 0).PasteSpecial xlPasteValues
    
    Application.DisplayAlerts = False
    wsDst.Delete
    Application.DisplayAlerts = True
    
End Sub