Macro saisie sur nouvelle ligne vide

Bonjour, n’ayant pas résolu mon problème, je reviens à la charge…

Sous Excel (2016 MSO (Version 2111)) j’ai créé un fichier d’une quinzaine d’onglets. Le 1er onglet sert de ‘base de données’ sous forme de fiche. Les éléments saisis dans cette base sont collés (via une macro) dans 5 onglets différents, sous forme de tableaux. Jusque-là j’ai su faire….

Là ou je calle, c’est que je souhaiterais, lors de la validation de ma fiche base de donnée, (via un bouton) les informations se positionnent sur la première ligne disponible en dessous de la précédente, sur les 5 tableaux différents.

Bonsoir ManMarg, bonsoir le forum,

Un petit fichier exemple simplifié mais reprenant l'environnement de ton fichier d'origine serait, comme toi, le bienvenu...
Si tes tableaux sont des tableaux structurés, ça devrait donner un code à adapter de ce style :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim I As Integer 'déclare la variable I (Incrément)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim PL As Range 'déclare la variable PL (PLage)

Set OS = Worksheets(1) 'définit l'onglet source (ici le premier onglet)
For I = 2 To Worksheets.Count 'boucle sur tous les autres onglets
    Set OD = Worksheets(I) 'définit l'onglet O
    Set TS = OD.ListObjects(1) 'définit le tableau structuré TS
    TS.ListRows.Add 'ajoute une ligne au tableau structuré TS
    Set PL = TS.DataBodyRange 'définit la plage PL
    'Renvoie la plage de l'onglet source dans la cellule redimensionnée de la nouvelle ligne en colonne 1
    PL(PL.Rows.Count, 1).Resize(1, PL.Columns.Count).Value = OS.Range("TA_Plage")
Next I 'prochain onglet de la boucle
End Sub

Bonjour,

Voici mon fichier

L'onglet 'accueil' est la base de donnée, en cliquant sur 'Valider' les éléments se positionnent sur la ligne N° 2 des onglets 'Référencier' 'Montage' 'démontage' 'Emb vide' et 'récap awb'. Mon souhait est que à la validation suivante, les éléments se positionnent sur la ligne N° 3 des 5 onglets, puis à la saisie suivante sur la ligne N° 4 et ainsi de suite

Bonsoir ManMarg, bonsoir le forum,

La règle d'or en VBA c'est d'éviter autant que que le peux les Select ou Activate inutiles. Ils ralentissent considérablement l'exécution du code et sont source de nombreux bugs. Tu peux faire un copier/coller en une seule ligne sans aucun Select avec :

OngletSource.Range("TaPlageSource").Copy OngletDestination.Range("TaCelllueDestination")

Ton code sur le même principe, sans aucun Select :

Sub Macro30()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TOS(1 To 5) As Worksheet 'déclare le tableau de 5 variable TOS (Tableau des OngletS)
Dim PLV As Integer 'déflare la variable PLV (Première Ligne Vide)

Set OS = Worksheets("Accueil") 'définit l'onglet source OS
Set TOS(1) = Worksheets("Référencier") 'définit l'onglet TOS(1)
Set TOS(2) = Worksheets("Montage") 'définit l'onglet TOS(2)
Set TOS(3) = Worksheets("Démontage") 'définit l'onglet TOS(3)
Set TOS(4) = Worksheets("Emb Vides") 'définit l'onglet TOS(4)
Set TOS(5) = Worksheets("recap AWB") 'définit l'onglet TOS(5)
For I = 1 To 5 'boucle sur 5 onglets
    PLV = TOS(I).Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la première ligne vide PLV de la colonne A de l'onglet TOS(I)
    OS.Range("B1").Copy TOS(1).Cells(PLV, "A") 'copie B1 de l'onglet OS et le colle dans la première ligne vide de la colonne A de l'onglet TOS(I)
    OS.Range("B3").Copy TOS(I).Cells(PLV, "B") 'copie B3 de l'onglet OS et le colle dans la première ligne vide de la colonne B de l'onglet TOS(I)
    OS.Range("D1").Copy TOS(I).Cells(PLV, "C") 'copie D1 de l'onglet OS et le colle dans la première ligne vide de la colonne C de l'onglet TOS(I)
    OS.Range("D3").Copy TOS(I).Cells(PLV, "D") 'copie D3 de l'onglet OS et le colle dans la première ligne vide de la colonne D de l'onglet TOS(I)
    OS.Range("F1").Copy TOS(I).Cells(PLV, "E") 'copie F1 de l'onglet OS et le colle dans la première ligne vide de la colonne E de l'onglet TOS(I)
    OS.Range("B5").Copy TOS(I).Cells(PLV, "F") 'copie B5 de l'onglet OS et le colle dans la première ligne vide de la colonne F de l'onglet TOS(I)
    OS.Range("B7").Copy TOS(I).Cells(PLV, "G") 'copie B7 de l'onglet OS et le colle dans la première ligne vide de la colonne G de l'onglet TOS(I)
    OS.Range("D5").Copy TOS(I).Cells(PLV, "H") 'copie D5 de l'onglet OS et le colle dans la première ligne vide de la colonne H de l'onglet TOS(I)
    OS.Range("F5").Copy TOS(I).Cells(PLV, "I") 'copie F5 de l'onglet OS et le colle dans la première ligne vide de la colonne I de l'onglet TOS(I)
    OS.Range("B9").Copy TOS(I).Cells(PLV, "J") 'copie B9 de l'onglet OS et le colle dans la première ligne vide de la colonne J de l'onglet TOS(I)
    OS.Range("B10").Copy TOS(I).Cells(PLV, "K") 'copie B10 de l'onglet OS et le colle dans la première ligne vide de la colonne K de l'onglet TOS(I)
    OS.Range("B11").Copy TOS(I).Cells(PLV, "L") 'copie B11 de l'onglet OS et le colle dans la première ligne vide de la colonne L de l'onglet TOS(I)
    OS.Range("D9").Copy TOS(I).Cells(PLV, "M") 'copie D9 de l'onglet OS et le colle dans la première ligne vide de la colonne M de l'onglet TOS(I)
    OS.Range("F9").Copy TOS(I).Cells(PLV, "N") 'copie F9 de l'onglet OS et le colle dans la première ligne vide de la colonne N de l'onglet TOS(I)
    OS.Range("D11").Copy TOS(I).Cells(PLV, "OS") 'copie D11 de l'onglet OS et le colle dans la première ligne vide de la colonne OS de l'onglet TOS(I)
    OS.Range("B15").Copy TOS(I).Cells(PLV, "P") 'copie B15 de l'onglet OS et le colle dans la première ligne vide de la colonne P de l'onglet TOS(I)
    OS.Range("D15").Copy TOS(I).Cells(PLV, "Q") 'copie D15 de l'onglet OS et le colle dans la première ligne vide de la colonne Q de l'onglet TOS(I)
    OS.Range("D13").Copy TOS(I).Cells(PLV, "R") 'copie D13 de l'onglet OS et le colle dans la première ligne vide de la colonne R de l'onglet TOS(I)
    OS.Range("F17").Copy TOS(I).Cells(PLV, "S") 'copie F17 de l'onglet OS et le colle dans la première ligne vide de la colonne S de l'onglet TOS(I)
    OS.Range("C17").Copy TOS(I).Cells(PLV, "T") 'copie C17 de l'onglet OS et le colle dans la première ligne vide de la colonne T de l'onglet TOS(I)
    OS.Range("D18").Copy TOS(I).Cells(PLV, "U") 'copie D18 de l'onglet OS et le colle dans la première ligne vide de la colonne U de l'onglet TOS(I)
    Application.CutCopyMode = False 'masque le clignotement lié au copier/coller
    'bordures, fond et police
    With TOS(I).Rows(DL) 'prend en compte la ligne DL de l'onglet TOS(I)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        With .Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        With .Font
            .Name = "Arial"
            .Size = 9
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
Next I 'prochain onglet de la boucle
End Sub

Bonjour,

J'ai 2 erreurs

une en cliquant sur le bouton et l'autre en visualisant le code

capture capture2

Re,

Oui désolé mais ton onglet s'appelle bizarrement "Accueuil" et pas "Accueil". Soit tu modifies le nom de ton onglet en Accueil soit tu modifie le code :

Set OS = Worksheets("Accueuil")


Oups ah ben oui, je ferais mieux de reprendre les bases avec des cours d'orthographe :-)J'ai rectifié le nom de l'onglet mais lors ce que je saisis une nouvelle fiche, les éléments se positionnent toujours sur la même ligne dans les onglets suivants, ils ne vont pas sur la ligne suivante

Re,

La ligne de destination PLV est calculée avec ce code :

    PLV = TOS(I).Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la première ligne vide PLV de la colonne A de l'onglet TOS(I)

Cela signifie qu'il faut toujours que B1 de l'onglet Accueil soit renseignée. Sinon il faut que je modifie le code pour prendre comme référence une colonne qui sera toujours remplie. Je n'ai jamais testé car j'ai la flemme de remplir tous les champs. Si tu veux que je teste, renvoie un fichier avec des données dans l'onglet Accueil...

Ci joint le fichier. La macro est sur le bouton Valider

Les onglets qui doivent être remplis et mis a la ligne suivante a chaque validation sont:

Référencier; Montage: démontage; Emb vide et récap AWB

Merci de ton aide

Re,

J'ai enfin testé et me suis vite rendu compte de ma c***erie. Le code revu et corrigée :

Sub Macro30()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TOS(1 To 5) As Worksheet 'déclare le tableau de 5 variable TOS (Tableau des OngletS)
Dim PLV As Integer 'déflare la variable PLV (Première Ligne Vide)

Set OS = Worksheets("Accueil") 'définit l'onglet source OS
Set TOS(1) = Worksheets("Référencier") 'définit l'onglet TOS(1)
Set TOS(2) = Worksheets("Montage") 'définit l'onglet TOS(2)
Set TOS(3) = Worksheets("Démontage") 'définit l'onglet TOS(3)
Set TOS(4) = Worksheets("Emb Vides") 'définit l'onglet TOS(4)
Set TOS(5) = Worksheets("recap AWB") 'définit l'onglet TOS(5)
For I = 1 To 5 'boucle sur 5 onglets
    PLV = TOS(I).Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la première ligne vide PLV de la colonne A de l'onglet TOS(I)
    TOS(I).Cells(PLV, "A") = OS.Range("B1").Value 'récupere la valeur de B1 dans la cellule ligne PLV colonne A de l'onglet TOS(I)
    TOS(I).Cells(PLV, "B") = OS.Range("B3").Value
    TOS(I).Cells(PLV, "C") = OS.Range("D1").Value
    TOS(I).Cells(PLV, "D") = OS.Range("D3").Value
    TOS(I).Cells(PLV, "E") = OS.Range("F1").Value
    TOS(I).Cells(PLV, "F") = OS.Range("B5").Value
    TOS(I).Cells(PLV, "G") = OS.Range("B7").Value
    TOS(I).Cells(PLV, "H") = OS.Range("D5").Value
    TOS(I).Cells(PLV, "I") = OS.Range("F5").Value
    TOS(I).Cells(PLV, "J") = OS.Range("B9").Value
    TOS(I).Cells(PLV, "K") = OS.Range("B10").Value
    TOS(I).Cells(PLV, "L") = OS.Range("B11").Value
    TOS(I).Cells(PLV, "M") = OS.Range("D9").Value
    TOS(I).Cells(PLV, "N") = OS.Range("F9").Value
    TOS(I).Cells(PLV, "OS") = OS.Range("D11").Value
    TOS(I).Cells(PLV, "P") = OS.Range("B15").Value
    TOS(I).Cells(PLV, "Q") = OS.Range("D15").Value
    TOS(I).Cells(PLV, "R") = OS.Range("D13").Value
    TOS(I).Cells(PLV, "S") = OS.Range("F17").Value
    TOS(I).Cells(PLV, "T") = OS.Range("C17").Value
    TOS(I).Cells(PLV, "U") = OS.Range("D18").Value
    With TOS(I).Rows(PLV).Font 'prend en compte la ligne DL de l'onglet TOS(I)
        .Name = "Arial" 'plice
        .Size = 9 'taille de la police
    End With
Next I 'prochain onglet de la boucle
End Sub

Génial

un grand merci

Rechercher des sujets similaires à "macro saisie nouvelle ligne vide"