Exploitation BD

Question

Bonjour,

Voila je viens de creer un fichier EXEL 
LA Feuil1(BD) est une base de données concernant des demande d'interventions:
REF; DATE;NOM;COMMUNE;APPAREIL ECT....

Je voudrais selectionner certaines lignes  de la base de données(en les cochant) pour 
les recopier apres la dernière ligne de données d'une autre feuille Feuil2(PLA)


Je souhaiterai que les lignes crées dans la Feuil2(PLA) soit supprimmées dans LA Feuil1(BD)

merci par avance pour l'aide que vous pourriez m'apporter

Cordialement

SFran · Answer

Bonjour entraide972
pour ton problème tu peux essayer la macro suivante.
Elle est à finaliser : pas d'effacement des lignes copiées (il faudrait faire un supprimer avec décalge vers le haut mais voir pour les cases à cocher que j'utilise), pas de point de départ automatique dans Feuil2 pour la copie mais ça peut être un début.

Fonctionnement (avec le fichier XL ce serait plus facile!!!)
Macro à exécuter depuis Feuil1, bouton ou menu macro.
Feuil1 :
        en col B --> REF, C --> NOM, ...
        en col A case à cocher liée à la même cellule (A1 pour case à cocher en A1, A2 pour A2, ...)
        couleur texte=couleur fond pour masquer le texte VRAI ou FAUX selon l'état de la case à cocher.

Ma macro comence son scan en ligne 2 (à adapter) et teste s'il y a quelque chose dans la cellule REF (col B),
    --> si oui, vérifie si case est cochée (VRAI en A de la ligne)
          --> si VRAI, sélectionne les colonnes de la ligne à partir de REF jusqu'à dernière col utilisée (ici B, C et D),
               et copie le contenu vers Feuil2,
          --> si FAUX, passe à la ligne suivante.
    --> si vide, fin de la macro

Pour la Feuil2, la copie commence (à modifier) en B10+inc (inc de 1 ligne à chaque copie)
Si ça peut t'être utile...
Cordialement

Sub Copie()
dep = 2 ' point de départ de la lecture
inc = 1
While Cells(dep, 2).Value <> ""
    Cells(dep, 2).Activate
    If (Cells(dep, 1).Value) Then
        Range(Cells(dep, 2), Cells(dep, 4)).Copy
        Worksheets("Feuil2").Activate
        Range(Cells(10 + inc, 2), Cells(10 + inc, 4)).Select
        ActiveSheet.Paste
        dep = dep + 1
        inc = inc + 1
        Worksheets("Feuil1").Activate
    Else
        dep = dep + 1
        Cells(dep, 2).Select
    End If
Wend
Application.CutCopyMode = False
End Sub

Cordialement

Exploitation BD

1 réponse

Discussions similaires

Newsletters