Modification code

Question

Je souhaiterais que l'insertion de cette ligne soit faite avec la valeur des cellules et non leur forme. Est ce possible? Set sh2 = Sheets("ArchivMouv") Set listobj2 = sh2.ListObjects("Tableau8") lig = 4 ListObj.ListRows(1).Range.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Merci d'avance Nonno Edit Modo : mis code en utilisant les balises de code...

Dan · Accepted Answer

Merci de bien vouloir utiliser les balises de codes en cliquant sur le bouton &lt;/&gt; et en collant vos codes dans la fenêtre. Pour votre demande, 1. à quoi correspond "listobj" ? 2. ce que vous voulez faire c'est ajouter une ligne en ligne 1 du tableau structuré ...

Dan · Accepted Answer

E xcusez moi mais vous lisez ce que je vous demande ? Votre code est à nouveau en brut dans votre post sans avoir utilisé les balises Vous êtes en tableau structuré donc si vous avez une liste déroulante elle sera toujours dans votre colonne que vous copiez la valeur des cellules ou non. Ce que vous voulez c'est copier du tableau6 (feuille Mouvement) vers le tableau8 (feuille Archmouvement), la ligne qui contient un A en feuille mouvement ? Que vient faire le I3 dans votre code ? Pourquoi J23 ? Mettez un fichier exemple sans données confidentielles, ce sera plus simple...

Dan · Accepted Answer

Au vu du code actuel, j'ai supposé que lorsque vous cliquez sur le bouton Validation, on doit compléter les deux feuilles. A voir si correct dans votre manière de procéder.

Si oui, voici ce que vous devez faire point par point et dans l'ordre :

1. Supprimez toutes les lignes vides dans les deux tableaux. Il ne faut jamais pas de lignes sans données dans un tableau structuré. En fonction de votre fichier posté, supprimez :
-- Feuille Mouvement : lignes 33 à 40 (si vides)
-- Feuille ArchivMouv : Lignes 6 à 636 (si vides)

2. Dans la feuille ArchivMouv,
-- sélectionnez B4 et B5 (ou B4 jusque dernière ligne de la colonne B contenant des données
-- allez dans le menu données et cliquez sur l'icone "Validation"
-- cliquez sur "Effacer tout" puis OK

3. Dans la feuille ArchivMouv,
-- supprimez les formules en colonne H
-- Sélectionnez H4 et remplacez la formule par --> =SOMME.SI.ENS([Sortie];[Référence];[@Référence]). Elle sera automatiquement recopiée sur chaque ligne de cette colonne. D'où important de la modifier en H4 au départ.

4. Dans votre module 1, remplacez votre code par celui ci-dessous

Sub mouv()
Dim Sh As Worksheet, sh2 As Worksheet
Dim lig As Integer

Set Sh = Sheets("Mouvement")
Set sh2 = Sheets("ArchivMouv")

With Sh.ListObjects(1)
    If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If
    With .DataBodyRange
        .Item(lig, 1) = Sh.Range("C7")
        .Item(lig, 2) = Sh.Range("C14")
        .Item(lig, 3) = Sh.Range("C9")
        .Item(lig, 4) = Sh.Range("C11")
        .Item(lig, 5) = Sh.Range("C16")
        .Item(lig, 6) = Sh.Range("C17")
    End With
End With

With sh2.ListObjects(1)
    If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If
    With .DataBodyRange
        .Item(lig, 1) = Sh.Range("C7")
        .Item(lig, 2) = Sh.Range("C14")
        .Item(lig, 3) = Sh.Range("C9")
        .Item(lig, 4) = Sh.Range("C11")
        .Item(lig, 5) = Sh.Range("C16")
        .Item(lig, 6) = Sh.Range("C17")
    End With
End With
End Sub

Reste le select case dans votre code. Je n'ai pas saisi le pourquoi en I21

Si ok -->

Cordialement

Dan · Accepted Answer

Re

Votre code comme ceci

Sub mouv()

If UCase(Sheets("Mouvement").Range("I3").value) = "A" Then

    Dim Sh As Worksheet, sh2 As Worksheet
    Dim lig As Integer

    Application.ScreenUpdating = False

    Set Sh = Sheets("Mouvement")
    Set sh2 = Sheets("ArchivMouv")

    With Sh.ListObjects(1)
        If .ListRows.Count = 0 Then
            .ListRows.Add: lig = 1
        Else: .ListRows.Add Position:=1: lig = 1
        End If
        With .DataBodyRange
            .Item(lig, 1) = Sh.Range("C7")
            .Item(lig, 2) = Sh.Range("C14")
            .Item(lig, 3) = Sh.Range("C9")
            .Item(lig, 4) = Sh.Range("C11")
            .Item(lig, 5) = Sh.Range("C16")
            .Item(lig, 6) = Sh.Range("C17")
            .Item(lig, 8) = Sh.Range("C12")
        End With
    End With

    With sh2.ListObjects(1)
        If .ListRows.Count = 0 Then
            .ListRows.Add: lig = 1
        Else: .ListRows.Add Position:=1: lig = 1
        End If
        With .DataBodyRange
            .Item(lig, 1) = Sh.Range("C7")
            .Item(lig, 2) = Sh.Range("C14")
            .Item(lig, 3) = Sh.Range("C9")
            .Item(lig, 4) = Sh.Range("C11")
            .Item(lig, 5) = Sh.Range("C16")
            .Item(lig, 6) = Sh.Range("C17")
            .Item(lig, 8) = Sh.Range("C12")
        End With
    End With

    Else
        MsgBox "Non autorisé"
    End If
Sh.Range("C12").ClearContents
Application.ScreenUpdating = True
End Sub

Remarques :
- Actuellement le code efface toujours la cellule C12 dans la feuille Mouvement. Il faudrait savoir dans quel cas la cellule doit être effacée. Est-ce quand vous complétez la feuille Mouvement ou pas ?
Si oui, cette ligne doit être placée avant le ELSE

- Dans votre feuille Source, effacez aussi les lignes vides dans chaque tableau. Si vous voulez comprendre après effacement des lignes vides, rajoutez une info dans la cellule juste en dessous de la dernière ligne contenant des données. Vous verrez que la nouvelle donnée sera automatiquement reprise dans le tableau.
Exemple : colonne Mois, supprimez la cellule M14 (--> clique droite dans la cellule M14 pour choisir "Supprimer" --> Lignes de tableau). Une fois fait, ajoutez une donnée en M14.

Faites quelques tests et dites moi

Dan · Answer

OK je regarde. Entre temps pouvez vous me dire : - pourquoi vous ajoutez ces trois lignes qui me semblent inutiles surtout avec un tableau au format structuré. Rows("40:40").Select 'Purge Tableau 6 Selection.Delete Shift:=xlUp Range("I3").Select - à quoi sert la ligne ci-dessous d'autant que si je comprends vous vérifiez que vous avez un A en I3 pour autoriser l'ajout les infos dans la tableau6 et 8. A = Range("I3") Vous avez aussi ajouté cette ligne --&gt; 'Application.Calculation = xlCalculationManual Là cela ne sert à rien dans votre cas, votre fichier est léger avec un nombre de formules limités. Ne vous encombrez pas de cette fonction. J'imagine que ce fichier n'est votre bon fichier mais je me pose la question de savoir si vous modifié les formules comme je vous ai écrit dans mon post précédent. Désolé de mes questions , mais j'essaie que votre fichier (bien foutu d'ailleurs !) soit le mieux possible...

Dan · Answer

Vous devez enlever cela. Il ne faut pas de lignes sans données dans un tableau au format structuré et comme je vous ai expliqué, l'ajout de ligne sera inclut automatiquement dans le tableau Dans la range I3 il y a une lettre et d'après ce que je vois dans le code, on n'ajoute que si un A est dans cette cellule. C'est correct ou pas pour vous ? Je vous pose ces questions parce que dans votre dernier fichier le début et la fin du code ne sont pas identiques à ce que je ai proposé avant...