XL 2010 Copier-coller impossible?

Laosurlamontagne

XLDnaute Occasionnel
Bonjour à tous,

Je deviens fou... Je n'arrive plus à faire un simple copier coller. La selection des données à copier (feuille "Perfo") est parfaite mais je n'arrive pas à la coller sur la dernière cellule libre de la ligne 50 de la feuille "Data"):

VB:
Sub bie()
Dim Adresse As Byte

       
For Each GPN In Range("GPN")
   Adresse = Sheets("Data").Cells(50, Columns.Count).End(xlToLeft).Column + 1
   MsgBox "la Dernière Cellule non Vide de la Ligne est " & Adresse
   
   Sheets("Perfo").Activate

   ActiveSheet.ListObjects("TablePerfo").Range.AutoFilter 'enlève les filtres existants
   ActiveSheet.ListObjects("TablePerfo").Range.AutoFilter 1, GPN ' filtre la colonne A
   'décale la plage pour ne pas prendre la ligne d'entêtes
   'reduit la plage d'une ligne pour compenser le décalage
   'Copie les lignes restantes et qui sont visibles
   ActiveSheet.ListObjects("TablePerfo").Range.Offset(0). _
   Resize(ActiveSheet.ListObjects("TablePerfo").Range.Rows.Count - 1). _
   SpecialCells(xlCellTypeVisible).Copy

Sheets("Data").Cells(50, Adresse).Paste

Next GPN
'revient à un affichage normal
ActiveSheet.ListObjects("TablePerfo").Range.AutoFilter
End Sub

Pourriez-vous m'aider à débloquer ce qui ne va pas?
 

Laosurlamontagne

XLDnaute Occasionnel
Ayé... enfin débloquer:

VB:
Sub bie()
Application.ScreenUpdating = False
Dim Adresse As String
For Each GPN In Range("GPN")
    Sheets("Perfo").Activate

    ActiveSheet.ListObjects("TablePerfo").Range.AutoFilter 'enlève les filtres existants
   ActiveSheet.ListObjects("TablePerfo").Range.AutoFilter 1, GPN ' filtre la colonne A
   'décale la plage pour ne pas prendre la ligne d'entêtes
   'reduit la plage d'une ligne pour compenser le décalage
   'Copie les lignes restantes et qui sont visibles
   ActiveSheet.ListObjects("TablePerfo").Range.Offset(0). _
    Resize(ActiveSheet.ListObjects("TablePerfo").Range.Rows.Count - 1). _
    SpecialCells(xlCellTypeVisible).Copy

    With ThisWorkbook.Sheets("Data")
        .Activate
        Adresse = .Cells(50, Columns.Count).End(xlToLeft).Offset(0, 1).Address
        MsgBox "la Dernière Cellule non Vide de la Ligne est " & Adresse
        .Range(Adresse).Select
        .Paste
    End With

Next GPN
'revient à un affichage normal
Sheets("Perfo").Activate
ActiveSheet.ListObjects("TablePerfo").Range.AutoFilter
Application.ScreenUpdating = True
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla