Macro archiver

LeRevenant · 24 Février 2016

Salut les gens, je suis en stage et on me demande de faire des choses qui nécessitent des macros, je m'en suis souvent sorti grâce à ce forum je me contente de copier/coller et changer des valeurs pour que ça marche dans mes cas, mais là je suis bloqué.... ça serait cool si un connaisseur pouvait m'aider

Pour faire simple:

Ici un fichier exemple bidon : Zippyshare.com - Macro archive.xlsm

Ce que la macro doit faire:
1)Aller dans l'onglet "Suivi"
2) regarder si jamais il y a une case non vide dans la cellule B:
-Si jamais la cellule est vide, tout va bien ne rien faire
-Si la cellule est non vide, alors couper/coller la ligne correspondante vers la première ligne vide de l'onglet "Archives"

C'est tout, petites informations utiles:
-Il se peut qu'il y ait plusieurs lignes à couper coller dans suivi
-Dans le vrai fichier, l'onglet archives comprendra des milliers de lignes

J'espère avoir été assez clair, merci et à bientôt.

Calvus · 25 Février 2016

Re : Macro archiver

Bonsoir et bienvenue sur XLD,

J'aurais bien jeté un oeil à ton fichier.....si tu l'avais posté ici....

A+

LeRevenant · 25 Février 2016

Re : Macro archiver

Fait

J'avais pas cherché à comprendre comment on fait, je passe toujours par un site
Pas de problème, merci.

DoubleZero · 25 Février 2016

Re : Macro archiver

Bonjour, LeRevenant, Calvus , le Forum,

Une suggestion avec le présent code.

Code:

Option Explicit
Sub Archiver()
    Application.ScreenUpdating = 0
    On Error GoTo fin
    Range("b1").AutoFilter
    ActiveSheet.Range("a:b").AutoFilter Field:=2, Criteria1:="<>"
    With Range("a2:a100000").Resize(, 2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants)
        .Copy Destination:=Sheets("Archives").Range("a" & Rows.Count).End(xlUp)(2)
        .EntireRow.Delete
    End With
    Range("b1").AutoFilter
    Exit Sub
fin:
    Range("b1").AutoFilter
    MsgBox "R. A. S. !"
    Application.ScreenUpdating = -1
End Sub

A bientôt

Calvus · 25 Février 2016

Re : Macro archiver

Re bonsoir,

Ton classeur en retour

VB:

Sub Copier()
Dim cel As Variant

Sheets("Suivi").Activate
    For Each cel In Range("B" & Rows.Count).End(xlUp)
        If cel <> "" Then
        cel.EntireRow.Copy Feuil2.[A500].End(xlUp).Rows(2)
        End If
    Next
Feuil2.Activate

End Sub

Il doit y avoir mieux car je ne suis pas un spéciaiste, mais ça fonctionne.

A+

EDIT : Oh pétard !!! fan de sort !! Voilà que 00 s'acharne sur moi ! Elle veut me coiffer au poteau et m'empêcher de progresser ! Tu mauras pas !!

Bonsoir 00

DoubleZero · 25 Février 2016

Re : Macro archiver

Re-bonjour,

Calvus à dit:
... je ne suis pas un spéciaiste...

Moi non plus

Calvus à dit:
... Elle veut me coiffer...

Un poisson avec des cheveux : drôle de bête !

A bientôt

Calvus · 25 Février 2016

Re : Macro archiver

Re,

En ces temps de végétaline, je me ferais bien un saucisson d'âne moi.....

Pardon Lerevenant, on règle juste nos comptes Double Zéro et moi !

DoubleZero · 25 Février 2016

Re : Macro archiver

Calvus à dit:
...En ces temps de végétaline, je me ferais bien un saucisson d'âne moi...

Toi être Calvus ou Piranha ?

Toutes mes excuses , LeRevenant !

A bientôt

LeRevenant · 25 Février 2016

Re : Macro archiver

Salut tout le monde,

Tout d'abord merci pour votre aide rapide et efficace, je suis proche du but!
J'ai essayé d'adapter la macro que Calvus a fait (elle marche très bien dans l'exemple que j'ai donné, mais je n'arrive pas à la faire marcher sur mon vrai tableau excel que je ne peux donner, faute de confidentialité).

Voici la macro:

Application.ScreenUpdating = 0
On Error GoTo fin
Range("j1").AutoFilter
ActiveSheet.Range("b:j").AutoFilter Field:=2, Criteria1:="<>"
With Range("j2:j100000").Resize(, 2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants)
.Copy Destination:=Sheets("Archive").Range("a" & Rows.Count).End(xlUp)(2)
.EntireRow.Delete
End With
Range("j1").AutoFilter
Exit Sub
fin:
Range("b1").AutoFilter
MsgBox "R. A. S. !"
Application.ScreenUpdating = -1

Ce qu'elle fait:
Elle coupe/colle la cellule J si non vide (très bien), elle colle seulement la cellule J (or il faudrait coller la ligne entière) vers l'onglet archive à la bonne place (très bien).

Donc le seul truc qui va pas=> Elle colle seulement la cellule alors qu'il faudrait qu'elle colle la ligne

Encore merci pour votre aide!

DoubleZero · 26 Février 2016

Re : Macro archiver

Bonjour, LeRevenant, Calvus , le Forum,

LeRevenant à dit:
... je n'arrive pas à la faire marcher sur mon vrai tableau excel que je ne peux donner, faute de confidentialité)...

A l'avenir, merci de bien vouloir déposer le "sosie" du fichier de travail, dépourvu des données confidentielles aisément modifiables...

Une autre suggestion ci-après :

VB:

Option Explicit
Sub Archiver_v2()
    With Application: .DisplayAlerts = 0: .ScreenUpdating = 0: End With
    On Error GoTo fin
    Range("j1").AutoFilter
    Activement.Range("j1").CurrentRegion.AutoFilter Field:=10, Criteria1:="<>"
    With Rows("2:" & Rows.Count).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants)
        .Copy Destination:=Sheets("Archives").Range("a" & Rows.Count).End(xlUp)(2)
        .Delete
    End With
    Range("j1").AutoFilter
    With Application: .ScreenUpdating = -1: .DisplayAlerts = -1: End With
    Exit Sub
fin:
    Range("j1").AutoFilter
    Exit Sub
    With Application: .ScreenUpdating = -1: .DisplayAlerts = -1: End With
End Sub

A bientôt

LeRevenant · 26 Février 2016

Re : Macro archiver

DoubleZero à dit:
A l'avenir, merci de bien vouloir déposer le "sosie" du fichier de travail, dépourvu des données confidentielles aisément modifiables...

Le voici

C'est pour mon stage, et ils rigolent pas du tout avec les données ... Donc elles sont supprimées et remplacées par des trucs bidons.

Mais sinon la mise en forme est la même.

Encore merci et bonne journée

DoubleZero · 26 Février 2016

Re : Macro archiver

Re-bonjour,

N'étant pas un poisson ... je nage mal , très mal !

En #1, il fallait prendre en compte la colonne b.

En #9, il fallait prendre en compte la colonne j.

En #11, le nouveau fichier déposé me plonge dans de ténébreuses profondeurs avant de me noyer...

A bientôt

LeRevenant · 26 Février 2016

Re : Macro archiver

DoubleZero à dit:
Re-bonjour,

En #11, le nouveau fichier déposé me plonge dans de ténébreuses profondeurs avant de me noyer...

A bientôt

Désolé de te mettre dans de tels états, mais le fait d'avoir mais le fichier en commentaire avait pour but d'aider...
Le truc c'est que la macro "marche très bien", le seul problème c'est qu'elle fait un couper coller d'UNE cellule, plutôt que la ligne. C'est juste ça.

Merci
À tôt bien

DoubleZero · 26 Février 2016

Re : Macro archiver

Re-bonjour,

LeRevenant à dit:
... le fichier en commentaire avait pour but d'aider...

LeRevenant à dit:
... la macro "marche très bien", le seul problème c'est qu'elle fait un couper coller d'UNE cellule, plutôt que la ligne...

C'est, en effet, l'action du code #4 sur deux cellules.

Sauf erreur de ma part, le code #10, quant à lui, fait le "couper coller" de la ligne entière. A-t-il été testé ?

LeRevenant à dit:
...À tôt bien

Stage bon et à bientôt

Macro archiver

LeRevenant

XLDnaute Occasionnel

Pièces jointes

Calvus

XLDnaute Barbatruc

LeRevenant

XLDnaute Occasionnel

DoubleZero

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

Pièces jointes

DoubleZero

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

DoubleZero

XLDnaute Barbatruc

LeRevenant

XLDnaute Occasionnel

DoubleZero

XLDnaute Barbatruc

LeRevenant

XLDnaute Occasionnel

Pièces jointes

DoubleZero

XLDnaute Barbatruc

LeRevenant

XLDnaute Occasionnel

DoubleZero

XLDnaute Barbatruc

Discussions similaires