BZH56
XLDnaute Occasionnel
Bonjour a tous
debutant en VBA, je bloque sur des bugs suite a recopie de donnée filtrée sur une autre feuille. lorsque je pense avoir régler un cas , j en génère un autre...
1er problème ;
les données sont copiées a la suite au lieu d' écraser ou effacer les précédentes (fichier journalier)
2 éme problème :
si aucune donnée nouvelle après test , la macro recopie a tord la ligne d en tête.mon test a zéro plante
3 3 ème problème
je veux limiter mon nombre de dossiers en archivage et j ai un souci de variable ou comptage je pense.
ci joint un extrait avec code et commentaires
merci du coup de pouce dans ma progression sur VBA
debutant en VBA, je bloque sur des bugs suite a recopie de donnée filtrée sur une autre feuille. lorsque je pense avoir régler un cas , j en génère un autre...
1er problème ;
les données sont copiées a la suite au lieu d' écraser ou effacer les précédentes (fichier journalier)
2 éme problème :
si aucune donnée nouvelle après test , la macro recopie a tord la ligne d en tête.mon test a zéro plante
3 3 ème problème
je veux limiter mon nombre de dossiers en archivage et j ai un souci de variable ou comptage je pense.
ci joint un extrait avec code et commentaires
Code:
Private Sub recopie_Click()
lig = [B65000].End(3).Row 'nombre de dossiers extraits
Lig2 = Feuil1.[B65000].End(3).Row + 1
Lig3 = Range("A65000").End(3).Row + 1 'determination de la premiere cellule libre dans la colonne
'effacement des donnees precedentes
'Sheets("Feuil1").Select
'activation du filtre
Sheets("archive").Select
ActiveSheet.Range("$A$1:$F" & lig).AutoFilter Field:=6, Criteria1:="<>"
'comptage du nombre de dossiers nouveaux
lig = [B65000].End(3).Row
'test si aucun dossier a traiter
' If lig = 0 Then MsgBox ("Attention , pas de nouveaux dossiers!! ")
' Exit Sub
'copie des nouveaux dossiers sur la feuille ' a traiter
Range("B2:E" & lig).Copy Feuil1.Range("B" & Lig2)
'stockage des numeros de dossiers traites
Range("B2:B" & lig).Copy Range("A" & Lig3) 'ok
'annulation du filtre
ActiveSheet.Range("$A$1:$F" & lig).AutoFilter Field:=6 'ok
'If Lig3 > 50 Then Range(2 & " : " & Lig3 - 50).Select
' Selection.Delete Shift:=xlUp
'effacement des donnees extraites
Sheets("archive").Select 'ok
Range("B2:E" & lig).ClearContents 'ok
End Sub
Pièces jointes
Dernière édition: