RechercheV d'une feuille unique

Bonjour à tous,

Dans le tableur ci-joint, je remplis l'onglet FNC en commençant par le numéro (cellule P5) puis toutes les autres cases.

Je souhaiterais que dans l'onglet Base NC, les informations correspondantes puissent se remplir automatiquement en fonction des intitulés (exemple : Je tape 2021-001 dans la cellule P5 de l'onglet FNC, je remplis la date d'ouverture cellule AD6 dans l'onglet FNC et la cellule B3 de l'onglet Base NC (qui correspond au numéro 2021-001) se rempli automatiquement. Et ce, pour toutes les informations.

En sachant qu'on effacera toujours les éléments de l'onglet FNC pour remplir une NC avec un autre numéro (par exemple 2021-002) et que je serais également amené à reprendre la NC 2021-001 pour la compléter ultérieurement.

Normalement, je fais le contraire (je remplis le tableau (base NC) et la feuille (FNC) se remplit automatiquement). Mais il est plus facile de remplir une fiche qu'un tableau.

J'espère avoir été assez clair

Merci d'avance pour votre aide précieuse.

William

Bonjour,

Pas certain que ce soit le plus optimal mais en associant à deux boutons, un pour importer pour modifier, et un pour exporter et modifier et des plages nommées correspondantes (cf Gestionnaire de noms) pour faire le lien entre cellule FNC et colonne BDD des NC :

Sub EXPORT()
Dim NC(0 To 36), I()
Dim R%, EXCLU As Boolean, L As Object, LR%, C%
On Error Resume Next
With Worksheets("FNC")
    I = Array(1, 2, 9, 13, 15, 20, 21)
    For R = 0 To 36
    EXCLU = False
        For C = LBound(I) To UBound(I)
            If I(C) = R Then EXCLU = True: Exit For
        Next C
    If EXCLU = False Then NC(R) = .Range("_" & R)
    Next R
    NC(1) = .Shapes("ORIGINE").OLEFormat.Object.List(.Shapes("ORIGINE").OLEFormat.Object.ListIndex)
    NC(2) = .Shapes("LIEU").OLEFormat.Object.List(.Shapes("LIEU").OLEFormat.Object.ListIndex)
    NC(9) = .Shapes("TYPO").OLEFormat.Object.List(.Shapes("TYPO").OLEFormat.Object.ListIndex)
    NC(13) = .Shapes("DEC").OLEFormat.Object.List(.Shapes("DEC").OLEFormat.Object.ListIndex)
    NC(15) = .Shapes("DEC_DER").OLEFormat.Object.List(.Shapes("DEC_DER").OLEFormat.Object.ListIndex)
    Set L = Worksheets("BASE NC").Columns(1).Find(.[P5])
End With
With Worksheets("Base NC")
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    If L Is Nothing Then
        .Cells(LR, 1).Offset(1).Redim(1, UBound(NC) + 2) = Application.WorksheetFunction.Transpose(NC)
        Else
        .Cells(L.Row, 2).Resize(1, UBound(NC)) = NC
    End If
End With
End Sub

Sub IMPORT()
Dim I()
Dim L As Object, R%, EXCLU As Boolean, C%
With Worksheets("FNC")
    Set L = Worksheets("BASE NC").Columns(1).Find(.[P5])
    I = Array(1, 2, 9, 13, 15, 20, 21)
    For R = 0 To 36
    EXCLU = False
        For C = LBound(I) To UBound(I)
            If I(C) = R Then EXCLU = True: Exit For
        Next C
    If EXCLU = False Then .Range("_" & R) = Worksheets("Base NC").Cells(L.Row, R + 2)
    Next R
    .Shapes("ORIGINE").OLEFormat.Object.List(.Shapes("ORIGINE").OLEFormat.Object.ListIndex) = Worksheets("Base NC").Cells(L.Row, 3)
    .Shapes("LIEU").OLEFormat.Object.List(.Shapes("LIEU").OLEFormat.Object.ListIndex) = Worksheets("Base NC").Cells(L.Row, 4)
    .Shapes("TYPO").OLEFormat.Object.List(.Shapes("TYPO").OLEFormat.Object.ListIndex) = Worksheets("Base NC").Cells(L.Row, 11)
    .Shapes("DEC").OLEFormat.Object.List(.Shapes("DEC").OLEFormat.Object.ListIndex) = Worksheets("Base NC").Cells(L.Row, 15)
    .Shapes("DEC_DER").OLEFormat.Object.List(.Shapes("DEC_DER").OLEFormat.Object.ListIndex) = Worksheets("Base NC").Cells(L.Row, 17)
End With
End Sub

Cf fichier joint.

Cdlt,

Merci beaucoup. Je suis désolé de vous déranger à nouveau.

Je vous ai remis en pièce jointe le fichier avec quelques précisions. J'ai intégré dans l'onglet FNC le N° des cellules en correspondance avec l'onglet Base NC. J'ai tenté moi même de rajouter via votre programme mais je n'ai rien compris . Est-il possible de les rajouter de la même façon que ce que vous m'avez déjà fait.

En outre, lorsque je tape dans la cellule P5 de l'onglet FNC un nouveau numéro, je souhaiterai importer les informations de l'onglet base test avec les cellules correspondantes (et forcément, si les cellules sont vides alors, rien n'apparaît).

Et pour conclure, j'ai mis certaines cellules avec des validations des données, je ne sais pas si ça pose un problème pour votre programmation.

Encore merci pour votre aide

William

Bonjour,

Ci-joint pour l'archivage, j'ai lié cette macro à votre logo pour le lancement. Je vous laisse changer en fonction de vos besoins :

Sub EXPORT()
Dim NC(0 To 40)
Dim R%, L As Object, LR%, C%
Application.ScreenUpdating = False
With Worksheets("FNC")
    For R = 0 To 39
        If R <> 20 Then
            NC(R) = .Range("_" & R)
            .Range("_" & R) = ""
        End If
    Next R
    Set L = Worksheets("BASE NC").Columns(1).Find(.[P5])
End With
With Worksheets("Base NC")
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    If L Is Nothing Then
        .Cells(LR, 1).Offset(1).Redim(1, UBound(NC) + 2) = Application.WorksheetFunction.Transpose(NC)
        Else
        .Cells(L.Row, 2).Resize(1, UBound(NC)) = NC
    End If
End With
Application.ScreenUpdating = True
End Sub

Et la macro événementielle pour charger les données dans le module de la feuille FNC :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim L As Object, R%, C%
Application.ScreenUpdating = False
If Not Application.Intersect(Target, [P5]) Is Nothing Then
    With Worksheets("FNC")
        Set L = Worksheets("BASE NC").Columns(1).Find(.[P5])
        If L Is Nothing Then MsgBox "NC non trouvée", vbCritical: Exit Sub
        For R = 0 To 39
            If R <> 20 Then .Range("_" & R) = Worksheets("Base NC").Cells(L.Row, R + 2)
        Next R
    End With
End If
Application.ScreenUpdating = True
End Sub

Et votre fichier joint.

Cdlt,

Super, merci beaucoup !!!!

Vous êtes un génie!!!

Bonjour Ergotamine,

Je sais que le sujet est clos mais après près d'un mois d'utilisation, nous nous rendons compte qu'il y a des modifications à apporter.

Je vous explique mais si cela vous pose un problème, je peux ouvrir un nouveau sujet sans soucis.

Nous avons modifié plusieurs colonnes (j'ai intégré le numéro des colonnes dans l'onglet FNC).

En outre, nous souhaitons que les informations cochées et en vert entre les lignes 59 et 115 de l'onglet FNC soient sauvegardées dans cet onglet avec le N° de FNC (cellule P5).

Si ce n'est pas trop compliqué, pouvez-vous m'expliquer comment changer votre code si je dois intégrer ou supprimer une cellule? Cela me permettra de ne plus vous déranger.

Merci à vous, et encore une fois, je ne veux pas déranger, donc si ça ne va pas, je crée un nouveau sujet

Bonjour,

Ci-contre votre code corrigé (non testé) :

Sub EXPORT()
Dim NC(0 To 52) 'A adapter
Dim R%, L As Object, LR%, C%
Application.ScreenUpdating = False
With Worksheets("FNC")
    For R = 0 To 52 'A adapter
        If R <> 27 Then 'A adapter
            NC(R) = .Range("_" & R)
            .Range("_" & R) = ""
        End If
    Next R
    Set L = Worksheets("BASE NC").Columns(1).Find(.[P5])
End With
With Worksheets("Base NC")
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    If L Is Nothing Then
        .Cells(LR, 1).Offset(1).Redim(1, UBound(NC) + 2) = Application.WorksheetFunction.Transpose(NC)
        Else
        .Cells(L.Row, 2).Resize(1, UBound(NC)) = NC
    End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim L As Object, R%, C%
Application.ScreenUpdating = False
If Not Application.Intersect(Target, [P5]) Is Nothing Then
    With Worksheets("FNC")
        Set L = Worksheets("BASE NC").Columns(1).Find(.[P5])
        If L Is Nothing Then MsgBox "NC non trouvée", vbCritical: Exit Sub
        For R = 0 To 52 'A adapter
            If R <> 27 Then .Range("_" & R) = Worksheets("Base NC").Cells(L.Row, R + 2) 'A adapter
        Next R
    End With
End If
Application.ScreenUpdating = True
End Sub

Si jamais vous rajoutez des colonnes ultérieurement voici un aperçu des manipulations réalisées :

- Sous le gestionnaire de noms, chaque cellule est identifiée par un nom en fonction de la colonne à renvoyer -2. Par exemple la cellule AD6 doit aller dans la colonne B de la base NC. La colonne B est la colonne 2, donc 2-2 = 0, donc je l'identifie _0. Cela avec toutes les cellules à renvoyer afin de les charger proprement dans le tableau de la macro.
- Les lignes du code VBA identifié comme à adapter sont les lignes où il est nécessaire de modifier la dimension du tableau ou l'incrément. Dans le précédent code, nous étions a 39 (nombre maximum dans mes gestionnaires de noms) nous sommes désormais a 52. Pour la partie <>, elle contient toutes les colonnes remplies manuellement dans la base NC et donc ne comportant pas de noms sous le gestionnaire de noms. Ici _27 n'existe pas car la colonne AC (29-2), la criticité n'est pas renseignée par votre formulaire FNC. Si je ne met pas le <>27 or <> des autres nombres compris entre 0 et 52, j'aurais une erreur car le nom n'existe pas. D'où cette précision.

En espérant que ces explications soient claires et vous aident à maintenir votre fichier.

Je vous laisse tester.

Cdlt,

Bonjour,

Merci pour toutes ces explications !!!

Par contre, est-il possible de sauvegarder pour chaque numéro de FNC toutes les lignes de la 59 à la 115 dans l'onglet FNC en sachant que celles-ci ne sont pas intégrées dans l'onglet Base NC. En fait, je souhaiterais que ces informations soient sauvegardées de la même façon que les autres et se reboot lorsque l'on appuie sur l'icône.

Encore un grand merci pour votre aide précieuse !!!