XL 2016 VBA transfere donnees si condition ok ,si condition remplie ne pas mettre de ligne blanche

[Fabien35200]

Bonjour à tous ,

J ai crée un code permettant de copier les cellules d un fichier à un autre si une condition d une colonne est indiqué.Cela dit lorsque la condition n est pas respectée,cela me retranscrit une ligne blanche,ce que je ne souhaite pas .Je pense qu il faut mettre une phrase après else disant de ne pas tenir compte de cette ligne,mais je bloque.
Ci joint le code:

Private Sub CommandButton1_Click()


Dim wkA As Workbook, wkB As Workbook


Dim x As Long


Dim j As Long


Dim h As Long








Application.ScreenUpdating = False


Set wkA = Workbooks("copie tableau de suivi test 2 .xlsm") ' classeur d arrivee


' Workbooks("copie tableau de suivi test .xlsm").Worksheets("BZH")


'Workbooks("tableau de bord - Copie du 4 mai - Copie.xlsm")


'Workbooks("tableau de bord - Copie du 4 mai - Copie.xlsm").Activate


Set wkB = Workbooks("tableau de bord - Copie du 4 mai - Copie.xlsm") ' classeur de donnée tableau de bord





x = wkB.Worksheets("relance completude").Range("A" & Rows.Count).End(xlUp).Row


h = wkA.Worksheets("Feuil3").Range("A" & Rows.Count).End(xlUp).Row


For j = 5 To x





If wkB.Worksheets("relance completude").Cells(j, 1) = "ok" Then





wkA.Worksheets("Feuil3").Cells(j, 1).Value = wkB.Worksheets("relance completude").Cells(j, 4).Value 'nom du projet


wkA.Worksheets("Feuil3").Cells(j, 2).Value = wkB.Worksheets("relance completude").Cells(j, 2).Value ' affaire mere


wkA.Worksheets("Feuil3").Cells(j, 3).Value = wkB.Worksheets("relance completude").Cells(j, 41).Value ' nom affaire colonne 1


wkA.Worksheets("Feuil3").Cells(j, 4).Value = wkB.Worksheets("relance completude").Cells(j, 40).Value ' n° affaire colonne 1


wkA.Worksheets("Feuil3").Cells(j, 5).Value = wkB.Worksheets("relance completude").Cells(j, 6).Value ' commune


Else














End If


Next j











End Sub



Merci beaucoup pour votre aide.

Fabien.

 

[Jacky67]

Bonjour,
Il y a ce qu'il faut sur le forum pour joindre un code Vb

Essaye en modifiant cette partie de ton code
H étant la ligne de début du collage

'--------------
    x = wkB.Worksheets("relance completude").Range("A" & Rows.Count).End(xlUp).Row
    h = wkA.Worksheets("Feuil3").Range("A" & Rows.Count).End(xlUp).Row + 1

    For j = 5 To x
        If wkB.Worksheets("relance completude").Cells(j, 1) = "ok" Then
            wkA.Worksheets("Feuil3").Cells(h, 1).Value = wkB.Worksheets("relance completude").Cells(j, 4).Value    'nom du projet
            wkA.Worksheets("Feuil3").Cells(h, 2).Value = wkB.Worksheets("relance completude").Cells(j, 2).Value    ' affaire mere
            wkA.Worksheets("Feuil3").Cells(h, 3).Value = wkB.Worksheets("relance completude").Cells(j, 41).Value    ' nom affaire colonne 1
            wkA.Worksheets("Feuil3").Cells(h, 4).Value = wkB.Worksheets("relance completude").Cells(j, 40).Value    ' n° affaire colonne 1
            wkA.Worksheets("Feuil3").Cells(h, 5).Value = wkB.Worksheets("relance completude").Cells(j, 6).Value    ' commune
            h = h + 1
        End If
    Next j
    '-----------

 

[Fabien35200]

merci enormement Jacky ,c est tout a fait ça!!!
et merci pour le renseignement d intégration du code

 

[Fabien35200]

je remarque que si je clique 2 fois sur mon bouton, la liste vient s ajouter à la première.Du coup je me retrouve avec des doublons.
Aurais tu une idée pour le code puisse prendre en compte le n° d affaire pour qu il ne soit indiqué qu' 1 seule fois dans le listing ?

 

[Jacky67]

je remarque que si je clique 2 fois sur mon bouton, la liste vient s ajouter à la première.Du coup je me retrouve avec des doublons.
Aurais tu une idée pour le code puisse prendre en compte le n° d affaire pour qu il ne soit indiqué qu' 1 seule fois dans le listing ?

Re..
Avec ce qui est montré, il m'est impossible de faire plus.

 

[Fabien35200]

Bonjour,

Oui je comprends,toutes mes excuses.
Ci joint les 2 classeurs à ouvrir avec le bouton dans le tableau de suivi test.Je souhaite que le nom de chantier n apparaisse qu une fois .Évidemment, si une modification venait a être effectuée sur le classeur données ,celle ci serait pris en compte lors d un nouveau clique.
Merci par avance.

 

[Jacky67]

Re...
Il y a une différence d'adressage de cellule entre la demande initiale et les classeurs fournis.
Si la colonne "affaire mere" est le n° d'affaire, alors ceci devrait faire.
**Code modifié

Private Sub CommandButton1_Click()
    Dim wkA As Workbook, wkB As Workbook
    Dim x As Long, Tmp&
    Dim j As Long
    Dim h As Long
    Application.ScreenUpdating = False
    Set wkA = ActiveWorkbook  '  classeur d arrivee
    Set wkB = Workbooks("Classeur données.xlsx")    ' classeur de donn?e
    h = wkA.Worksheets("Feuil1").Cells.Find("*", , , , xlByRows, xlPrevious).Row
    With wkB.Worksheets("relance completude")
        x = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        For j = 2 To x
            If LCase(.Cells(j, 1)) = "ok" And IsError(Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)) Then
                h = h + 1
                wkA.Worksheets("Feuil1").Cells(h, 1).Value = .Cells(j, 2).Value     'nom du projet
                wkA.Worksheets("Feuil1").Cells(h, 2).Value = .Cells(j, 3).Value     ' affaire mere
                wkA.Worksheets("Feuil1").Cells(h, 3).Value = .Cells(j, 4).Value   ' nom affaire colonne 1
                wkA.Worksheets("Feuil1").Cells(h, 4).Value = .Cells(j, 5).Value    ' commune
            End If
        Next j
    End With
End Sub

 

[Fabien35200]

merci Jacky,malheureusement ça ne fonctionne pas.
Le premier clique fait apparaitre la liste correctement, au revanche ,si on clique une nouvelle fois ,la liste se réécrit à la suite de la première.Il ne prend pas en compte que l affaire mère est déjà présente.
L objectif serait qu il n y ai qu une fois l affaire mere dans la liste malgre le nombre de clique et cela sans effacer la liste deja existante .En effet ,ce tableau vit avec des colonnes indépendantes au fichier " classeur de données" en rapport avec les affaires meres .De ce fait ,en effectuant une mise à jour par le clique , l ensemble des donnees resteraient exploitables.

 

[Jacky67]

Re.
Les deux classeurs ouverts, je n'éprouve aucune difficulté à faire ce qui est demandé.
Ne copie pas les données si l'affaire mère (colonne B) est déjà présente

 

[Fabien35200]

merci beaucoup Jacky.
Pourrais tu m expliquer cette ligne afin que je puisse comprendre:

If LCase(.Cells(j, 1)) = "ok" And IsError(Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)) Then

J aimerai savoir ,si un jour quelques cellules sont modifiées sur une affaire mere dans le tableau de données, comment pourrais je faire pour la transcrire en ne la doublant pas dans le tableau de suivi?

très grand merci à toi.

 

[Jacky67]

merci beaucoup Jacky.
Pourrais tu m expliquer cette ligne afin que je puisse comprendre:

If LCase(.Cells(j, 1)) = "ok" And IsError(Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)) Then

J aimerai savoir ,si un jour quelques cellules sont modifiées sur une affaire mere dans le tableau de données, comment pourrais je faire pour la transcrire en ne la doublant pas dans le tableau de suivi?

très grand merci à toi.

If LCase(.Cells(j, 1)) = "ok" And IsError(Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)) Then

if LCase(.Cells(j, 1)) = "ok"
Si Minuscule Cellule(ligne J , colonne A="ok"
And=ET
Application.match=Equivalent de "Equiv()" dans une cellule
Si dans la colonne B de==> wkA.Worksheets("Feuil1")
on ne trouve pas (iserror)
la valeur cellule (ligne j , colonne 3) de ==> wkB.Worksheets("relance completude")
alors seulement le code suivant est exécuté.
En gros
Si la ligne testée en cours en colonne A il y a "ok"
et Si dans la colonne B du classeur cible il n'y a pas encore la valeur de la cellule colonne 4 du classeur Source
Alors exécution.

Cette version tient compte des changements sur une affaire mere déjà copié et confirmé par ok
et supprime la ligne si ok est supprimer

Private Sub CommandButton1_Click()
    Dim wkA As Workbook, wkB As Workbook
    Dim x As Long, Tmp&
    Dim j As Long
    Dim h As Long
    Application.ScreenUpdating = False
    Set wkA = ActiveWorkbook  '  classeur d arrivee
    Set wkB = Workbooks("Classeur données.xlsx")    ' classeur de donn?e
    h = wkA.Worksheets("Feuil1").Cells.Find("*", , , , xlByRows, xlPrevious).Row
    With wkB.Worksheets("relance completude")
        x = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        For j = 2 To x
            If LCase(.Cells(j, 1)) = "ok" Then
                If IsError(Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)) Then
                    h = h + 1
                    wkA.Worksheets("Feuil1").Cells(h, 1).Value = .Cells(j, 2).Value     'nom du projet
                    wkA.Worksheets("Feuil1").Cells(h, 2).Value = .Cells(j, 3).Value     ' affaire mere
                    wkA.Worksheets("Feuil1").Cells(h, 3).Value = .Cells(j, 4).Value   ' nom affaire colonne 1
                    wkA.Worksheets("Feuil1").Cells(h, 4).Value = .Cells(j, 5).Value    ' commune
                Else ' si modification et ok
                    If IsNumeric(Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)) Then
                        Tmp = Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)
                        wkA.Worksheets("Feuil1").Cells(Tmp, 1).Value = .Cells(j, 2).Value     'nom du projet
                        wkA.Worksheets("Feuil1").Cells(Tmp, 2).Value = .Cells(j, 3).Value     ' affaire mere
                        wkA.Worksheets("Feuil1").Cells(Tmp, 3).Value = .Cells(j, 4).Value   ' nom affaire colonne 1
                        wkA.Worksheets("Feuil1").Cells(Tmp, 4).Value = .Cells(j, 5).Value    ' commune
                    End If
                End If
            Else ' si ok supprimer
                If IsNumeric(Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)) Then
                    Rows(Application.Match(.Cells(j, 3).Value, wkA.Worksheets("Feuil1").[b:b], 0)).Delete
                End If
            End If
        Next j
    End With
End Sub

 

[Fabien35200]

je suis très impressionné par ton professionnalisme et te remercie énormément pour toute l aide que tu m as apporté.
Bonne soirée à toi.

 

[Fabien35200]

Bonjour,

Comment pourrais je faire pour que la colonne A dans le fichier tableau de suivi test V2 ait un nom bien spécifique. Je m explique,celle ci est transcrite par le "1 " dans le code " Cells(h, 1) ".
Je pose cette question car si des colonnes venaient a être intégrer par la suite j aimerai pouvoir modifier les colonnes avec une attribution des le début du code et ainsi eviter de tout modifier dans l ensemble du code.
Merci beaucoup.

 

[Jacky67]

Bonjour,

Comment pourrais je faire pour que la colonne A dans le fichier tableau de suivi test V2 ait un nom bien spécifique. Je m explique,celle ci est transcrite par le "1 " dans le code " Cells(h, 1) ".
Je pose cette question car si des colonnes venaient a être intégrer par la suite j aimerai pouvoir modifier les colonnes avec une attribution des le début du code et ainsi eviter de tout modifier dans l ensemble du code.
Merci beaucoup.

RE..
j aimerai pouvoir modifier les colonnes avec une attribution des le début du code
Alors passer en mode "Tableau structuré", les colonnes ont un nom automatiquement
Sinon pour donner un nom(ici "LeNom") dynamique à la colonne A de la feuille nommée "Feuil1" la syntaxe est:

 ActiveWorkbook.Names.Add "LeNom", "=OFFSET(Feuil1!$A$1,1,,CountA(Feuil1!$A:$A)-1)"

Ne serait-il pas mieux de copier des lignes entières et de supprimer les colonnes inutiles????
Il y a un moment ou il faut choisir

 

[Fabien35200]

Merci Jacky. Je ne pense qu il serait compliqué de faire ça car chaque ligne du tableau original possède plus de 300 colonnes. Le tableau de réception a 25 colonnes ,c est la raison pour laquelle je pense plutôt designer un nom au colonne du 2° tableau.