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

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()"...

Jacky67

XLDnaute Barbatruc
Re...
Il est beaucoup plus simple et rapide de filtrer les données d'un tableau selon un ou plusieurs critères de copier le résultat de ce filtre dans un autre classeur et d'en éliminer les colonnes inutiles, plutôt que de traiter chaque cellule par ligne.
Mais c'est toi qui voit
 

Fabien35200

XLDnaute Nouveau
en fait j ai un dossier ' affaire mere' qui est susceptible de generer jusqu à 10 sous dossiers .J avais creer initialement ces lignes en fonction de l affaire mere.Le souci maintenant est que je dois retranscrire des lignes prenant en compte le sous dossier.De ce fait ,je ne peux pas filtrer sinon les différentes extractions ne se feront pas.
 

Fabien35200

XLDnaute Nouveau
j ai voulu essayer ta propostion :
ActiveWorkbook.Names.Add "LeNom", "=OFFSET(Feuil1!$A$1,1,,CountA(Feuil1!$A:$A)-1)"

et je n y arrive ,j ai cherché sur le net comment fonctionne ,mais je patine.Comment ,pour une colonne,ce code pourrait s adapter ?
 

Jacky67

XLDnaute Barbatruc
Re...
Et moi je ne comprends plus rien…..
Il fallait copier certaines données d'un classeur à un autre sous certaines conditions.
Je pense que les codes successifs qui j'ai publié font ce qui est demandé.
Maintenant, il est question de rajouter des colonnes, de dossier, de sous dossier et de chose qui ne se feront pas.
Sauf a avoir des structures de classeur complètes et définitives, et des explications claires, je cède la main.
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…