VBA selection de la ligne avec condition

Bonjour,

Je cherche un code pour dire :

Si la référence existe déjà dans la colonne A alors se placer au niveau de cette ligne, sinon aller à la dernière ligne non remplie. Voici la partie du code correspondante et un fichier joint.

La partie en rouge bloque.

Dim WSsource As Worksheet, WScible As Worksheet

Dim L As Long

Dim Référence As String

Référence = Filename

Dim ColonneA As String

ColonneA = Range("A2:A65536")

Dim Plage As Range, Cell As Range

Set WSsource = ThisWorkbook.Worksheets("Fiche NC")

Set WScible = Workbooks("MES.ENR.GE.01 Registre des NC").Worksheets("Tableau")

If ColonneA = Référence Then

L = Cell.Row

Else

L = WScible.Range("A65536").End(xlUp).Row

Set Plage = WScible.Range("A2:A" & WScible.Range("A65536").End(xlUp).Row)

End If

Merci d'avance

Marie

Bonjour,

merci de rester sur le premier et de ne pas créer des fils inutilement qui ne permettent pas le suivi.

https://forum.excel-pratique.com/excel/probleme-dans-code-macro-enregistrement-dans-tableau-t22446.html

Amicalement

Edit Dan : Fil réactivé

Re,

Workbooks("MES.ENR.GE.01 Registre des NC.xls")

Mon conseil est de ne jamais nommer un fichier avec des points. Au niveau système c'est une erreur surtout si utilisé sur d'autre plateform OS.

Il faut laisser les points pour que le système comprenne bien qu'il s'agit d'une extension de fichier et non d'un nom.

Il vaut mieux laisser un espace ou mieux encore ceci --> Workbooks("MES_ENR_GE_01_Registre_des_NC.xls")

Merci de m'informer sur :

• A quoi correspond Filename ? Est-ce le nom du fichier dans lequel se trouve le code ?
• Les deux fichiers wscible et wssource sont-ils bien ouverts lors de l'exécution du code

Effectivement, j'ai transformé le nom du fichier en MES-ENR-01 Registre des NC et j'ai rajouté l'extension .xlsm

J'ai également ajouté une commande pour ouvrir le classeur avant le transfert.

Concernant filename et référence, j'ai supprimer cette partie : la référence de la NC est obtenue grâce à une formule CONCATENER dans la cellule M2 et c'est la valeur de cette cellule qui donne le nom du fichier lors de l'enregistrement.

Le transfert ce fait correctement à chaque fois sur la première ligne vide.

Maintenant je ne sais pas comment ajouter une commande pour dire :

si la référence de la NC (contenu dans la cellule M2) est déjà présente dans la colonne A du tableau MES-ENR-01 Registre des NC, alors c'est la ligne correspondante qui est compléter et sinon la NC est transferée sur la première ligne vide.

Merci du temps passé à résoudre mon problème.

Marie

Re,

Code à essayer :

Set WScible = Workbooks("MES-ENR-GE-01 Registre des NC.xlsm").Worksheets("Tableau")
On Error Resume Next
lg = WorksheetFunction.Match(WSsource.Range("M2"), WScible.Range("A1:A" & WScible.Range("A65536").End(xlUp).Row), 0)
If lg > 0 Then
L = lg
Else: L = WScible.Range("A65536").End(xlUp).Row + 1
End If
On Error GoTo 0
With WScible
'....

Coller ce code dans la macro Tranferer en lieu et place des instructions qui y sont actuellement

Au début du code on peut essayer ceci pour l'ouverture du fichier :

Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "MES-ENR-GE-01 Registre des NC.xlsm"

Amicalement

Merci pour le code mais il y un problème,

la macro s'arrête sur :

.Range("A" & L) = WSsource.Range("Référence").Value

avec comme indication : "Objet requis".

Je ne comprends pas le problème.

J'ai peut être mal inclus ton code, voir dans le fichier ci-joint.

Par contre j'ai réussis à ajouter un lien hypertexte sur la référence, le problème vint peut être de là.

Encore merci pour ton aide que me fais avancer à pas de géant.

-- 01 Avr 2011, 16:14 --

J'ai oublié de préciser que j'avais transformée

lg = WorksheetFunction.Match(WSsource.Range("M2"), WScible.Range("A1:A" & WScible.Range("A65536").End(xlUp).Row), 0)

en lg = WorksheetFunction.Match(WSsource.Range("M4"), WScible.Range("A1:A" & WScible.Range("A65536").End(xlUp).Row), 0)

Car je l'ai changé de place dans la feuille

Je sais pas si c'est utile que je vous le dise mais bon comme ça c'est fait

Re,

Pas nécessaire de reposter le fichier à chaque post. Cela alourdit le forum et j'ai de toute façon une copie reprenant mes interventions.

la macro s'arrête sur :

.Range("A" & L) = WSsource.Range("Référence").Value

avec comme indication : "Objet requis".

Logique si Reference n'est pas définit comme nom. Que doit-on trouver en Range("A" & L ) ?? le nom d'un fichier ??

Amicalement

Merci de votre réponse. Comme il s'agit de document sur un réseau au boulot, je n'y ai pas accès le week end.

Alors référence est le nom que j'ai attribué à la cellule dans Fiche NC et qui contient ce que je veux mettre dans la colonne A du tableau de registre des NC.

Re,

Hum... dans le dernier fichier joint je ne vois plus l'instruction ci-dessous :

Set WSsource = ThisWorkbook.Worksheets("Fiche NC")

J'ai avais pensé, car effectivement WSsource n'est plus définit.

Mais la macro ne fonctionne toujours pas avec un blocage au même endroit.

Voici le code que j'ai mis :

Sub Transfert()

' sert à transférer les données des fiches dans le tableau

Dim Classeur_NC_en_cours As String

Classeur_NC_en_cours = ActiveWorkbook.Name

Dim WSsource As Worksheet
Set WSsource = ThisWorkbook.Worksheets("Fiche NC")
On Error Resume Next
    Workbooks.Open Filename:= _
        "\\SERVEUR01\Partage\Système de Management\Document du Système de Management\Processus MESURES - MES\Non-conformité\MES-ENR-01 Registre des NC.xlsm"

 Workbooks(Classeur_NC_en_cours).Activate

Set WScible = Workbooks("MES-ENR-GE-01 Registre des NC.xlsm").Worksheets("Tableau")

On Error Resume Next
lg = WorksheetFunction.Match(WSsource.Range("M4"), WScible.Range("A1:A" & WScible.Range("A65536").End(xlUp).Row), 0)
If lg > 0 Then
L = lg
Else: L = WScible.Range("A65536").End(xlUp).Row + 1
End If
On Error GoTo 0

With WScible

.Range("A" & L) = WSsource.Range("Référence").Value
.Range("B" & L) = WSsource.Range("Date").Value
.Range("C" & L) = WSsource.Range("Nom").Value
.Range("D" & L) = WSsource.Range("OrigineNC").Value
.Range("E" & L) = WSsource.Range("TypeNC").Value
.Range("F" & L) = WSsource.Range("Client").Value
.Range("G" & L) = WSsource.Range("NTravail").Value
.Range("H" & L) = WSsource.Range("NCommande").Value
.Range("I" & L) = WSsource.Range("Réfpièce").Value
.Range("J" & L) = WSsource.Range("RéfNCClient").Value
.Range("K" & L) = WSsource.Range("Description").Value
.Range("L" & L) = WSsource.Range("Traitement").Value
.Range("M" & L) = WSsource.Range("Conséquence").Value
.Range("N" & L) = WSsource.Range("Coût").Value
.Range("O" & L) = WSsource.Range("Causes").Value
.Range("P" & L) = WSsource.Range("OrigineNCanalysée").Value
.Range("Q" & L) = WSsource.Range("Service").Value
.Range("R" & L) = WSsource.Range("Actions").Value
.Range("S" & L) = WSsource.Range("Délai").Value
.Range("T" & L) = WSsource.Range("Pilote").Value
.Range("U" & L) = WSsource.Range("Dateaction")
.Range("V" & L) = WSsource.Range("Quiaction").Value
.Range("W" & L) = WSsource.Range("Efficacité").Value
.Range("X" & L) = WSsource.Range("DateClos").Value
.Range("Y" & L) = WSsource.Range("CommentairesClos").Value

.Hyperlinks.Add Anchor:=.Range("A" & L), Address:="\\SERVEUR01\Partage\Système de Management\Document du Système de Management\Processus MESURES - MES\Non-conformité\NC enregistrées\" & WSsource.Range("Référence").Value & ".xlsm"

End With

' Sauver_Fermer_classseur Registre NC

Dim WBname As String
Application.Run "'MES-ENR-01 Registre des NC.xlsm'!Enregistrer"
Workbooks(WBname).Close
Workbooks("MES-ENR-01 Registre des NC.xlsm").Close savechanges:=True

'lien hypertext

End Sub

Re,

Logique ...

d'un coté on parle de "MES-ENR-01 Registre des NC.xlsm" et de l'autre "set wscible =Workbooks("MES-ENR-GE-01 Registre des NC.xlsm")...."

Puis en début de code on trouve

Dim Classeur_NC_en_cours As String
Classeur_NC_en_cours = ActiveWorkbook.Name
...
...
 Workbooks(Classeur_NC_en_cours).Activate

Cela sert à quoi tout cela ???

Effectivement merci pour votre regard extérieur, car j'avais corriger le nom de ce classeur, mais set wscible =Workbooks("MES-ENR-GE-01 Registre des NC.xlsm")...." ça m'avais échapper.

A force de travailler sur ce code je finis par plus le voir.

Concernant cette partie :

Dim WBname As String
Application.Run "'MES-ENR-01 Registre des NC.xlsm'!Enregistrer"
Workbooks(WBname).Close
Workbooks("MES-ENR-01 Registre des NC.xlsm").Close savechanges:=True

j'avais rajouter cette partie pour retourner sur la fiche de NC, une fois que le classeur de registre s'est ouvert.

Je viens de faire un essai avec la correction dans le nom.

Il y avait une autre erreur, alors j'ai transformé (obtenu par un enregistrement de macros) :

Dim WBname As String
Application.Run "'MES-ENR-01 Registre des NC.xlsm'!Enregistrer"
Workbooks(WBname).Close
Workbooks("MES-ENR-01 Registre des NC.xlsm").Close savechanges:=True

en ça :

Workbooks("MES-ENR-01 Registre des NC.xlsm").Close savechanges:=True

Et ça marche, enfin je crois. Je vais faire plus d'essais et je reviens vers le forum pour confirmer ou (ah horreur j'espère que non !!!!) vous exposez mes autres bugs.

Et encore merci milles fois de votre aide !!!!

Bonjour,

Voilà j'ai fais plusieurs essais et on dirais bien que ça marche.

Je mettrai en oeuvre le document la semaine prochaine et les utilisateurs me remonteront leur propositions d'améliorations et leurs bugs.

Dan, merci beaucoup pour ton aide précieuse.

Marie