Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

F

Fabien35200

XLDnaute Nouveau
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.
 
Solution
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()"...
Trier par date Trier par votes

Jacky67

XLDnaute Barbatruc
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
VB: 
'--------------
    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
    '-----------
 
Dernière édition:
Vote positif 0 Vote négatif
F

Fabien35200

XLDnaute Nouveau
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 ?
 
Vote positif 0 Vote négatif
F

Fabien35200

XLDnaute Nouveau
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.
 

Pièces jointes

  • tableau de suivi test.xlsm
    19.8 KB · Affichages: 13
  • Classeur données.xlsx
    8.4 KB · Affichages: 7
Vote positif 0 Vote négatif

Jacky67

XLDnaute Barbatruc
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é
VB: 
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
 
Dernière édition:
Vote positif 0 Vote négatif
F

Fabien35200

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif

Jacky67

XLDnaute Barbatruc
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
 

Pièces jointes

  • tableau de suivi test.xlsm
    18.8 KB · Affichages: 5
Vote positif 0 Vote négatif
F

Fabien35200

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

VB: 
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.
 
Vote positif 0 Vote négatif

Jacky67

XLDnaute Barbatruc
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
VB: 
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
 

Pièces jointes

  • tableau de suivi test V2.xlsm
    20.2 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif
Solution
F

Fabien35200

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif

Jacky67

XLDnaute Barbatruc
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:
VB: 
 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
 
Vote positif 0 Vote négatif
F

Fabien35200

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
439
florian50470
F
A
  • Question
Microsoft 365 Copier le contenu d'une feuille dans une autre par une macro
Réponses
2
Affichages
944
AlexAGEMS
A
J
  • Question
XL 2016 Transformer un nouveau Tableau à double entrée en liste en VBA - impossibilité d'adapter le code
2
Réponses
23
Affichages
1 K
patricktoulon
T
  • Question
XL 2016 Modification de données sur 2 feuilles différentes via UserForm
Réponses
14
Affichages
2 K
tontonboulii
T
N
  • Question
Autres Envoi mail automatique (suivant numéro de la semaine)
Réponses
2
Affichages
2 K
Nikoko
N
S
  • Résolu(e)
XL 2016 Si doublon dans une colonne copier des valeurs sur la même ligne que la cellule recherchée
Réponses
9
Affichages
2 K
Surferdargent
S
D
  • Résolu(e)
XL 2016 Envoi si Condition
Réponses
13
Affichages
1 K
Dymouille
D
N
  • Résolu(e)
XL 2016 Lenteur à l'insertion de ligne en VBA
Réponses
5
Affichages
2 K
Nicocotte125
N
L
  • Question
XL 2010 Aide VBA copier collé si condition respecté
Réponses
5
Affichages
2 K
fanch55
B
  • Question
XL 2019 Rechercher la ligne d'un tableau et mettre à jour une cellule VBA
Réponses
0
Affichages
2 K
bluesky12000
B
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…