Macro création liste

Bonjour à tous, j'ai un petit problème pour créer une macro excel (sous excel 2003).

Dans une première feuille excel, je dois rentrer des données tous les jours dans un tableau se présentant comme tel :

3 lignes dont les titres sont 011, 021, 031 (en cellule A8, A9 et A10)

6 colonnes (correspondant aux 6 données que je dois rentrer manuellement pour chaque ligne, allant des cellules B8 à G8)

je dois aussi renseigner manuellement le numéro de mois (titre A1 - donnée B1), le numéro de semaine (titre A2 - donnée B2), une date de début (titre A3 - donnée B3) et une date de fin (titre A4 - donnée B4)

Ensuite, j'ai un bouton à côté du tableau sur lequel je clique pour activer une macro.

Cette macro est censée faire un copier/coller (dans une deuxième feuille excel) de ce type :

MOIS / SEMAINE / DATE DEBUT / DATE FIN / 011 / Donnée 1 / Donnée 2 / Donnée 3 / Donnée 4 / Donnée 5 / Donnée 6

MOIS / SEMAINE / DATE DEBUT / DATE FIN / 021 / Donnée 1 / Donnée 2 / Donnée 3 / Donnée 4 / Donnée 5 / Donnée 6

MOIS / SEMAINE / DATE DEBUT / DATE FIN / 031 / Donnée 1 / Donnée 2 / Donnée 3 / Donnée 4 / Donnée 5 / Donnée 6

Mon problème :

J'aimerais créer une liste dans la feuille 2, c'est à dire qu'à chaque fois que j'active la macro en cliquant sur le bouton, celle-ci fasse un copier-coller à la suite de la liste (je n'arrive qu'à faire un copier-coller toujours au même endroit ... ce qui efface mes données de la veille)

Merci d'avance pour votre aide.

Bonjour

Pour atteindre la premiere ligne vide sous ton tableau, il faut décaler la dernière ligne pleine de 1.

DerLign= .Range("A" & Rows.Count).End(xlUp).Row + 1

Cordialement

Bonjour Amadéus.

Merci pour la réponse, mais j'avoue que je ne comprends pas ta ligne de code...

En plus j'ai du changer mon fichier, alors pour faire plus simple voilà ma macro actuelle :

Sub Enregistrement()

'

' Enregistrement Macro

' Macro enregistrée le 28/05/2010 par BCLEMENT

'

'

Range("A6:M8").Select

Selection.Copy

Sheets("Feuil2").Select

ActiveWindow.SmallScroll Down:=-12

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

End Sub

Elle copie la plage de cellules allant de A6 à M8 de la feuille "Feuil1"

Elle colle (collage spécial en valeur) cette plage dans la feuille "Feuil2"

Ainsi elle créée (elle est censée...) une liste dans la feuille 2 à partir de la ligne 2 cellule A (en ligne 1 j'ai mes titres de colonnes)

Mais bien sûr, elle efface les précédentes données puisque je n'arrive pas à faire ce copier/coller à la suite des précédentes.

Merci pour l'aide!

Bonjour

Il vaut mieux que tu joignes un extrait de ton fichier.

Amicalement

Nad

Bonsoir à tous,

Sans collage spécial, cette ligne devrait suffire

Range("A6:M8").Copy Destination:=Sheets("Feuil2").Range("A65536").End(xlUp)(2)

Amicalement

Claude

Merci Dubois je vais essayer.

Nad, comment puis je vous transmettre un extrait de fichier excel?

Bonjour

Démo pour joindre un fichier :

http://www.youtube.com/watch?v=EbNYLzTz5wM

Amicalement

Nad

Voilà mon fichier.

J'ai oublié de préciser ceci :

Quand on appuie sur le bouton "ENREGISTREMENT", j'aimerais qu'il y ait une confirmation à effectuer sous cette forme (si bien sûr cela est possible) :

On clique sur le bouton "ENREGISTREMENT"

Dans les deux cas, on appuie sur OK et la boite de dialogue disparait

Merci pour votre aide

Bonjour,

Réponds déjà aux messages précédents !

mon code donnait-il satisfaction ?

si oui on peut ajouter la confirmation

Claude

Oui elle marche presque :

je cherche à coller en valeur les données (je ne veux pas de formules dans ma feuille "base de données")

et le message de confirmation serait très appréciable pour éviter les erreurs humaines.

Merci quand même Dubois!

-- 02 Juin 2010, 11:53 --

Bon, mon projet a été refusé parce qu'il comportait trop de risques d'erreur humaine.

J'ai donc du revoir mon fichier, et la Macro qui va avec ...

Mais bien sûr, elle s'est complexifiée et je suis complètement perdu.

Je vous joins mon nouveau fichier, les explications sont à l'intérieur.

Merci d'avance.

Bonjour

Sub enregistre()

msg = "Confirmer l'enregistrement dans la base de données"
Style = vbOKCancel + vbDefaultButton2
Title = "ENREGISTREMENT"
Response = MsgBox(msg, Style, Title)
If Response = vbCancel Then End

Range("A6:M8").Copy Destination:=Sheets("BASE DE DONNEES").Range("A65536").End(xlUp)(2)

With Sheets("BASE DE DONNEES").Range("A2:M" & Sheets("BASE DE DONNEES").UsedRange.Rows.Count)
.Interior.ColorIndex = -4142
End With

MsgBox ("Données enregistrées")

Range("A6:J8").ClearContents
End Sub

Il doit y avoir moyen de faire le collage spécial valeur intégré à la ligne de copie mais moi je ne sais pas. Claude va sans doute te donner la solution.

Amicalement

Nad

Edit - Ce code correspondait à ton 1er fichier - je vois que tu en as mis un autre

Re

3

La macro va d'abord vérifier que les 3 codes ne sont pas déjà présents dans la liste (ce code est unique)

Si ils sont présents (ce qui veut dire que les données ont déjà été enregistrées pour ce jour -> le but est d'éviter les doubles saisies), un message apparait :

["ERREUR : Les données pour cette journée sont déjà enregistrées dans la base de données" ; OK]

On clique alors sur OK et la macro s'arrête à ce niveau, le message disparait, les données rentrées manuellement ne s'efface pas.

Si ils ne sont pas présents dans la liste, alors on passe à la prochaine étape sans qu'aucun message ne s'affiche.

Est-ce que l'on peut retrouver qu'un seul (ou deux) code(s) en doublon ou bien c'est automatiquement les 3 ?

Nad

Les 3 codes étant uniques, si on trouve un seul des 3 dans la Base de données, alors c'est que les 3 y sont.

Donc oui, il est possible de ne rechercher qu'un seul code.

OK - Mais, si j'ai bien compris, on peut retrouver un même code du moment qu'il ne s'agit pas du même jour.

Tu confirmes ?

Je ne comprends pas bien ta question, je vais essayer d'y répondre :

Les codes sont formés par

[mois][semaine][jour][011]

[mois][semaine][jour][021]

[mois][semaine][jour][031]

Les codes sont donc uniques.

re,

Sub Enregistrement()
Dim Rep%
    Range("A6:M8").Select
Rep = MsgBox("Confirmer l'enregistrement dans la base de données? ", vbYesNo + vbCritical + vbDefaultButton2, "Enregistrement")
    If Rep = vbYes Then
         Range("A6:M8").Select
        Range("A6:M8").Copy
            With Sheets("Feuil2")
                .Range("A65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
            End With
        Application.CutCopyMode = False
        MsgBox ("Données enregistrées")
    Else
        MsgBox ("Données non enregistrées")
    End If
    Range("a1").Activate
End Sub

Amicalement

Claude

édit: çà va un peu vite là ! j'ai pas vu le dernier fichier

Merci Claude, ta macro est excellente!

Oui entre temps mon projet n'a pas été validé parce qu'il y a une possibilité de double saisie.

J'ai donc refais un autre fichier pour éviter ça, il faudrait jsute rajouter la vérification à ta macro et ca serait parfait !

re, Salut Nad,

D'où viennent les données de la colonne "E" qui font partie du code ?

Pourquoi 3 lignes (6 à 8) ? et se limiter à 3

sinon pourquoi ne pas valider ligne par ligne (ligne 6) ?

le contrôle serait + aisé

Claude

Re

J'ai complété le code de Claude (bonjour à toi).

Avec le code ci-dessous, toutes les données sont enregistrées MAIS si le code est en double la dernière ligne le concernant est supprimée.

Sub Enregistrement()
    Dim Rep%

    Rep = MsgBox("Confirmer l'enregistrement dans la base de données? ", vbYesNo + vbCritical + vbDefaultButton2, "Enregistrement")
        If Rep = vbYes Then
             Range("A6:N8").Copy
                With Sheets("BASE DE DONNEES")
                    .Range("A65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
                End With
            Application.CutCopyMode = False
            MsgBox ("Données enregistrées")
        Else
            MsgBox ("Données non enregistrées")
        End If

With Sheets("BASE DE DONNEES")
        .Activate
        .UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
        For i = .Range("A65536").End(xlUp).Row + 1 To 2 Step -1
        If .Range("A" & i) = .Range("A" & i + 1) Then
        .Range("A" & i).EntireRow.Delete
        End If
        Next
   End With

With Sheets("SAISIE")
.Activate
.Range("B6:J8").ClearContents
End With

End Sub

Nad

Nad,

Je vois que tu te lance ! dans le VBA, bravo,

Pour ce cas, il serait préférable de contrôler si doublons avant la saisie, plutôt que

d'avoir à les supprimer après coup dans la base.

d'où ma précédente question

Amicalement

Claude

édit vois ce lien

https://forum.excel-pratique.com/excel/msgbox-si-doublon-t17530.html