Filtrer, copier et coller des données dans un autre classeur

Papillon34

XLDnaute Nouveau
Bonjour,

Je suis nouvelle dans ce forum et surtout débutante en vba!!!
Pour mon travail, mon patron m'a demandé de réaliser un programme qui va permettre d'un fichier nommé " Holding" de réaliser des filtres puis copier les données filtrées dans un autre classeur nommé "Ventilation"! Le problème que je rencontre c'est que le début fonction jusqu'au copier où ca ne fonctionne plus!!! Ca fait une semain que j'y suis dessus mais je ne trouve pas l'erreur et la macro a rajouté!!!!

Voici le code que j'ai fais

Code:
Sub Macro1()
'Macro1 Macro
' Macro enregistrée le 09/10/2007

    Windows("Balance holding.xls").Activate 'J'active ma feuille hoding
    ActiveSheet.Range("A1").AutoFilter , Field:=1, Criteria1:="<70601000>", VisibleDropDown:=False  'je réalise mon filtre en ne voulant que le compte 70601000.
    Dim i As Integer
    i = 1
    While Cells(i, 1) <> "" '1 représente ici la colonne
    Cells(i, 1).Copy ' je veux copier les données (seulement ce n'est pas la ligne deux mais une ligne n
    
    Windows("Ventilation des charges.xls").Activate
    Feuil3.Range("A12:c12").PasteSpecial ' Je veux le coller sur la colonne A et ligne 12!
    Operation = xlPasteSpecialOperationAdd
    
Wend
End Sub

Je sais que pour le coller j'ai faux mais je ne vois pas quoi mettre!!!

Merci de bien vouloir m'aider!!!!
 

Bebere

XLDnaute Barbatruc
Re : Filtrer, copier et coller des données dans un autre classeur

bonjour Papillon
essaye ce code non testé,si problème tu reviens

Sub Macro1()
'Macro1 Macro
' Macro enregistrée le 09/10/2007
Dim Rng As Range, ShDest As Worksheet
Windows("Ventilation des charges.xls").Activate
'sh feuille destination
Set ShDest = Worksheets("Sheet2")

Windows("Balance holding.xls").Activate 'J'active ma feuille hoding
With ActiveSheet
.Range("A1").AutoFilter , Field:=1, Criteria1:="<70601000>" ', VisibleDropDown:=False 'je réalise mon filtre en ne voulant que le compte 70601000.

On Error Resume Next
Set Rng = .Range("F1").Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
.ShowAllData
End With
Rng.Copy

Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1).Copy _
Destination:=ShDest.Range("A12")


End Sub

à bientôt
 

Discussions similaires

Statistiques des forums

Discussions
312 430
Messages
2 088 365
Membres
103 831
dernier inscrit
Benjaminlutz