copie du texte d'une cellule dans une autre feuille selon plusieurs conditions sur la ligne

[oozenot]

Bonjour à tous !

Je met le code de ce que je veux faire : Sur chaque ligne je teste la présence de "X" sur 2 colonnes et copie la valeur d'une autre cellule de cette ligne selon la disposition des "X".
La copie s'effectue dans un autre classeur et sur des colonnes prédéfinies selon la disposition des X..
Je me suis sûrement emmêlé les pinceaux parce que le programme ne fait pas vraiment ce que je veux..., pas tout à fait !!
la copie a l'air bonne mais les conditions pas toutes.. déjà si qqn pouvait m'aider à simplifier les conditions.... ^^

Merci bcp d'avance pour le temps passé à me répondre !

Option Explicit

Sub Macro1()
Dim ln_src As Long
Dim col_src As Integer
Dim ln_dst As Integer
Dim col_dst, coltest As Integer
Dim ws_h, ws_p As Worksheet


Set ws_h = Sheets("Habilitations_par_Profils")
Set ws_p = Sheets("Rôles_par_Profil")

' initialisation en-tête

ln_dst = 2
col_dst = 1

' 5 colonnes à traiter 
For col_src = 23 To 78 Step 5
    For ln_src = 3 To 1000
            If LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "" Then
                If LCase(ws_h.Cells(ln_src, 13)) = "c" AND LCase(ws_h.Cells(ln_src, 83)) <> "N/A" Then
                    ws_h.Cells(, 83).Copy ws_p.Cells(ln_dst, col_dst)
                    ln_dst = ln_dst + 1
                End If
            ElseIf LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "x" Then
                If LCase(ws_h.Cells(ln_src, 13)) = "c" AND LCase(ws_h.Cells(ln_src, 85)) <> "N/A" Then
                    ws_h.Cells(ln_src, 85).Copy ws_p.Cells(ln_dst, col_dst)
                    ln_dst = ln_dst + 1
                End If
            End If
        
    Next
    col_dst = col_dst + 1
    ln_dst = 2
Next


End Sub

 

[oozenot]

bon c'est encore moi...

en fait en le relisant j'ai appercu qqs fautes.. et ca fonctionne bel et bien mtn...
néanmoins si qqn avait un moyen de rendre le code plus "simple" au niveaux des conditions répétitives.. je suis preneur !!!

Option Explicit

Sub Macro1()
Dim val As String
Dim ln_src As Long
Dim col_src As Integer
Dim ln_dst As Integer
Dim col_dst, coltest As Integer
Dim ws_h, ws_p As Worksheet


Set ws_h = Sheets("Habilitations_par_Profils")
Set ws_p = Sheets("Rôles_par_Profil")

ln_dst = 2
col_dst = 1

For col_src = 23 To 78 Step 5
    For ln_src = 3 To 1000
            If LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "" Then
                If LCase(ws_h.Cells(ln_src, 13)) = "c" and LCase(ws_h.Cells(ln_src, 83)) <> "n/a" Then
                    ws_h.Cells(ln_src, 83).Copy ws_p.Cells(ln_dst, col_dst)
                    ln_dst = ln_dst + 1
                End If
            ElseIf LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "x" Then
                If LCase(ws_h.Cells(ln_src, 13)) = "c" and LCase(ws_h.Cells(ln_src, 85)) <> "n/a" Then
                    ws_h.Cells(ln_src, 85).Copy ws_p.Cells(ln_dst, col_dst)
                    ln_dst = ln_dst + 1
                End If
            End If
        
    Next
    col_dst = col_dst + 1
    ln_dst = 2
Next


End Sub

 

[drul]

Pour améliorer, tu pourrais:

1) déplacer "ln_dst = 2" entre les deux for et ainsi ne pas avoir besoin de faire l'init avant le premier for.
2) supprimer les if imbriquer en rajoutant les conditions du deuxième if dans le premier.
3) Calculer le nombre de ligne que tu dois réelement traiter, plutôt que de faire arbitrairement une boucle jusqu'à 1000 (la fonction end(xlUp) de l'objet range t'y aidera).

Et pour les yeux des gens qui t'aide sur ce forum, utiliser la baliser CODE=VB au lieu de CODE tout seul

Pour le reste, ben si tu as beaucoup de conditions, c'est normal que les if soient un peu compliqué (et par expérience, faut pas chercher à trop simplifier, après ça devient illisible par autrui).

 

[zeb]

Salut

Ben voilà, t'as qu'à faire comme drul te le dit.

Moi, ce bout de programme m'a bien amusé.
Voici comment je l'ai maltraité :

Pour commencer, je mets tes tests un au dessus de l'autre :

If     LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = ""  Then If LCase(ws_h.Cells(ln_src, 13)) = "c" and LCase(ws_h.Cells(ln_src, 83)) <> "n/a" Then ws_h.Cells(ln_src, 83).Copy ws_p.Cells(ln_dst, col_dst): ln_dst = ln_dst + 1 : End If
ElseIf LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "x" Then If LCase(ws_h.Cells(ln_src, 13)) = "c" and LCase(ws_h.Cells(ln_src, 85)) <> "n/a" Then ws_h.Cells(ln_src, 85).Copy ws_p.Cells(ln_dst, col_dst): ln_dst = ln_dst + 1 : End If

Je vire les constantes :

""  83
"x" 85

Ca, faut le paramétrer, le reste il faut le factoriser

For i = 83 To 85 Step 2
	If LCase(ws_h.Cells(ln_src,     col_src)) =  "x"                  And _
	   LCase(ws_h.Cells(ln_src, col_src + 1)) =  IIf(i = 83, "", "x") And _
	   LCase(ws_h.Cells(ln_src,          13)) =  "c"                  And _
	   LCase(ws_h.Cells(ln_src,           i)) <> "n/a"                Then
	   	
	    ws_h.Cells(ln_src, i).Copy ws_p.Cells(ln_dst, col_dst)
	    ln_dst = ln_dst + 1
	    Exit For
	End If
Next

Bon, à part ça, il y a une petite erreur dans ton code. A la ligne 7. Sauras-tu la trouver ?

---------------------

Mais quelle horreur toutes ces coordonnées que tu te trimballes.
Utilise les objets !

T'as onze blocks de 998 (?) lignes par 5 colonnes.

Alors

Set cell_dest = ws_p.Cells(2, 1) ' A2

For k = 0 To 10
	For Each row_h In ws_h.Range(ws_h.Cells(   3, k * 5 + 23), 
	                             ws_h.Cells(1000, k * 5 + 28)).Rows

		If LCase(row_h.EnrireRow.Cells(13)) =  "c" And _
		   LCase(row_h.Cells(1)           ) =  "x" Then

			For i = 83 To 85 Step 2
				If LCase(row_h.Cells(2)          ) =  IIf(i = 83, "", "x") And _
				   LCase(row_h.EnrireRow.Cells(i)) <> "n/a"                Then
					
					row_h.Cells(i).Copy ws_p.Cells(row_dst, col_dst)
					Set cell_dest = cell_dest.Offset(1)
					Exit For
				End If
			Next
		End If
		Set cell_dest = cell_dest.Offset(0, 1).EntireColumn.Cells(2)
	Next
Next

:sol:

 

[drul]

Bon, à part ça, il y a une petite erreur dans ton code. A la ligne 7. Sauras-tu la trouver ?

LOL, j'avais raté celle là.
Le pire c'est qu'il a fait juste à la ligne 5

 

[zeb]

Certes.

 

[oozenot]

Merci beaucoup à vous 2 pour vos réponses, je regarde tout ca et je modifie mon code.

Je suis aussi en train de plancher sur une façon pour ne faire la copie que si la valeur de la cellule n'existe pas déjà dans la colonne de destination.. je penche pour la fonction RechercheV... je regarde dans ce sens et vous tient au courant.

Merci encore

 

[drul]

L'operateur "like" peux peut-être t'aider ...