J'essaie de copier une plage spécifique à partir d'une feuille protégée qui a un filtre automatique avec quelques lignes dans la plage filtrées. Lorsque vous utilisez le code suivant, seules les lignes visibles de la plage sont copiées:

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

Comme je l'ai dit, la feuille est protégée (et pour diverses raisons, je ne peux pas la déprotéger dans la macro), donc je ne peux pas utiliser de commandes qui résoudraient normalement le problème comme ceci:

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

J'ai pu annuler le filtre:

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

Cela me permet de copier toutes les lignes, mais je ne peux pas comprendre comment faire fonctionner le filtre à nouveau (car je dois laisser la feuille exactement comme je l'ai trouvée) sans être bloquée par la protection de la feuille.

J'apprécierais soit une solution qui supprime temporairement le filtre et le reprend après la copie, soit une solution qui me permette de copier toute la plage, y compris les lignes cachées / filtrées sans jouer avec le filtre lui-même.

0
eli-k 26 oct. 2020 à 13:30

2 réponses

Meilleure réponse

Le code suivant ajoute une nouvelle feuille de calcul et copie la plage entière dans la nouvelle feuille de calcul où vous pouvez ensuite copier et coller où vous le souhaitez

J'ai dirigé la copie pour qu'elle soit en dessous des données filtrées existantes, mais cela peut être redirigé

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
1
eli-k 28 oct. 2020 à 09:08

Je ne suis pas sûr qu'il soit possible de copier des cellules invisibles par "copie". Autant que je sache, ce n'est pas possible.

Cependant, il est possible de lire chaque cellule valeur / propriétés de style cellule par cellule.

Il devrait fonctionner correctement pour les plages plus petites, mais il est vraiment lent lorsque nous avons plus de cellules (il essaie de lire chaque valeur au lieu de copier la plage entière et cela prend du temps).

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

Cependant, je recommande de copier un fichier (ou une feuille de calcul au moins) pour supprimer le filtre, copier toute la plage et supprimer le fichier / feuille que vous venez de copier.

1
Salamander Krajza 26 oct. 2020 à 12:18