Discussion :

[rvtoulon]

bonsoir à tous,
j'essaye d'écrire un code pour copier le contenu des colonnes A et B en fonction d'un critère dans la colonne C. Je colle ensuite ces données dans une autre feuille.
apparement j'arrive à séléctionner mes colonnes et copier mes données, mais j'ai une erreur qui s'affiche. "Erreur d'éxécution '438', propriété ou méthodes non gérée par cet objet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub essai()
Dim N As Integer
 
For N = 3 To 10
Sheets("Feuil1").Select
'Si dans la colonne C il y a PA
If Range("C" & N) = "PA" Then
' Alors sélectionne les données des colonnes A et B correspondante et copie
Range(("A" & N), ("B" & N)).Copy
End If
'dans la feuil 2 colonne A
Sheets("Feuil2").Range("A" & N).Paste 'Erreur sur cette ligne
Next N
Application.CutCopyMode = False
 
End Sub

que dois-je faire?

[rvtoulon]

Re bonsoir,
j'ai modifié mon code et ça fonctionne, je n'ai plus d'erreur, seulement un autre problème se pose. Si dans la colonne de critère il n'y a pas le critère définie pour l'exemple PA il me recopie plusieur fois la ligne précédente jusqu'a ce qu'il trouve à nouveau PA que faire?
voici le code modifié:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub essai()
Dim N As Integer
 
For N = 3 To 10
Sheets("Feuil1").Select
'Si dans la colonne C il y a PA
If Range("C" & N) = "PA" Then
' Alors sélectionne les données des colonnes A et B correspondante et copie
Range(("A" & N), ("B" & N)).Copy
End If
'dans la feuil 2 colonne A colle
Sheets("Feuil2").Select
Range("A" & N).Select
ActiveSheet.Paste
Next N
Application.CutCopyMode = False
 
End Sub

[casefayere]

Bonsoir,

veux-tu coller tes cellules à la meme place ? avec des vides entre elles ?

adapte un truc comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub essai()
Dim x As Integer, y As Integer
With Sheets("feuil1")
x = 1
For y = 3 To 10
If .Range("c" & y) = "PA" Then
    Sheets("feuil2").Range("a" & x) = .Range("a" & y)
    Sheets("feuil2").Range("b" & x) = .Range("b" & y)
    x = x + 1
End If
Next y
End With
End Sub

[rvtoulon]

slt casefayere, si possible j'aimerais qu'elle se suive, effectivement. j'ai réussi à coller juste ce que je souhaite mais j'ai effectivement des blancs. je cherche comment les enlever. voici mon nouveau code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub essai()
Dim N As Integer
 
For N = 3 To 10
Sheets("Feuil1").Select
'Si dans la colonne C il y a PA
If Range("C" & N) = "PA" Then
' Alors sélectionne les données des colonnes A et B correspondante et copie
Range(("A" & N), ("B" & N)).Copy
'dans la feuil 2 colonne A colle
Sheets("Feuil2").Select
Range("A" & N).Select  'je pense que je dois modifier cette ligne !!
ActiveSheet.Paste
Else
End If
Next N
Application.CutCopyMode = False
 
End Sub

[rvtoulon]

Merci beaucoup c'est exactement ce qu'il me fallait .
ton code est extra.
juste une question sur ce code.
est-il possible de coller les données sur une feuille d'un autre classeur?

[casefayere]

si ton autre classeur est ouvert, il suffit de préciser son nom :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

workbooks("son nom").sheets("son nom")

sinon regardes dans le forum pour un classeur fermé

[rvtoulon]

ok, merci pour tout j'ai appris plein de truc ce soir.
mon problème est résolu je vais clôturé la discussion.
A+ Casefayere et encore merci

[Qwazerty]

Salut
Je vois bien que tout a deja ete fait mais vu que j'avais gratté un truc ^^ je le met.
En conservant ton idée de départ, la modif implique juste que la colonne A soit toujours renseigné.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub essai()
Dim TheCell As Range
 
'For N = 3 To 10
For Each TheCell In Range(Sheets("Feuil1").Range("A3"), Cells(Rows.Count, "A").End(xlUp)) 'implique que A soit renseigné
    'Sheets("Feuil1").Select 'evites les select ca ralenti le code
    'Si dans la colonne C il y a PA
    'If Range("C" & N) = "PA" Then
    If TheCell.Offset(0, 2) = "PA" Then ' on est sur la case A on va voir deux case plus loin en C donc
        ' Alors sélectionne les données des colonnes A et B correspondante et copie
        'Pour la ligne suivante cela implique que le colonne A ne doit jamais etre vide
        'Sheets("Feuil1").Range(("A" & N), ("B" & N)).Copy Sheets("Feuil2").Range("A3" , Sheets("Feuil2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0))
        TheCell.Resize(2).Copy Sheets("Feuil2").Range("A3", Sheets("Feuil2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0))
        'Resize permet de modifier la zone des cellules "selectionnées"
        'dans la feuil 2 colonne A colle
        'Sheets("Feuil2").Select
        'Range("A" & N).Select  'je pense que je dois modifier cette ligne !! en effet, je te l'ai integré dans la ligne au dessus
        'ActiveSheet.Paste
    'Else 'inutiles si pas de code
    End If
Next
Application.CutCopyMode = False
 
End Sub

A++
Qwaz

[casefayere]

Bonjour Qwazerty,

C'est chouette que tu proposes ta solution, moi je n'ai fait ça que pour éviter les copier/coller mais j'ai oublié de dire à rvtoulon (Bonjour rv) que s'il il garde les données copiées, et ajouter des données par la suite, il faudra changer la valeur de "x", au lieu de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

x = 1

mettre par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

x = Sheets("feuil2").Range("a65000").end(xlup).row + 1

bonne journée

[Qwazerty]

Salut Casefayere
J'avoue que je ne sais pas ce qui est le plus "performant", sachant qu'ici je doute que la quantité de données a traiter soit gigantesque, entre le copier coller et le transfert de contenu comme tu l'as fait, perso je pense que ton code est plus rapide, j'ai gardé le copier pour essayer de garder le travail deja réalisé par rvtoulon.
Pour ce qui est de la valeur de x, en effet il faudra l'adapter a chaque lancement de la procédure, ce qui impliquera donc aussi d'avoir une colonne systématiquement rempli, dans ton cas comme dans le mien nous avons choisi le colonne A, ce qui peut facilement être adapté par Rv pour prendre en compte une autre colonne.
Bonne continuation
++
Qwaz

[rvtoulon]

bonjour, Qwazerty et casefayere, merci pour votre aide.
dans l'exemple que j'ai utilisé je ne traite que 10 lignes, alors qu'en réalité
il y en a pratiquement 1400, ce chiffre peut varier mais pas de beaucoup.

lorsque vous dites qu'il faut que la colonne A soit toujours pleine cela veut dire
que si je demande de faire une boucle sur 1450 lignes sachant que dans les dernières lignes il n'y auras peut-être pas d'informations "cela ne marcheras pas".

quoi qu'il en soit merci pour vos codes car étant débutant, cela va me donner
de quoi m'exercer. je suis tres interessé par la fonction resize car après avoir copié mes données dans la feuil2, il faut que je sélectionne tous ce qui a été coller afin d'enlever les doublons (la colonne B de la feuil2, contient des noms, et le but c'est d'enlever les doublons afin de compter le nombre de personnes différentes et d'afficher le résultat dans une cellule par exemple A1, mais ceci fera l'objet d'une autre discussion).

désolé si je n'ai pas tout dit au départ
encore MERCI

[rvtoulon]

Salut à tous.
Bon voilà j'ai finalement choisis la méthode de Casefayere que je remercie encore beaucoup.
j'ai réussi également à enlever les doublons de ma liste et a renvoyée le nombre de noms différent de celle-ci simplement en comptant les lignes.
voici le code finale:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub PA()
'Sélection des PA
 
Dim x As Integer, y As Integer, Nbligne As Long
Dim Bd As Worksheet, Synt As Worksheet
Set Bd = Worksheets("Bd")
Set Synt = Worksheets("Synthèse")
 
Nbligne = [TabPA].Rows.Count
 
With Bd
x = 5
For y = 4 To 1450
If .Range("D" & y) = "PA" Then
    Synt.Range("A" & x) = .Range("B" & y)
    Synt.Range("B" & x) = .Range("C" & y)
    x = x + 1
End If
Next y
End With
 
Application.CutCopyMode = False
[TabPA].RemoveDuplicates Columns:=2, Header:=xlYes
[C2] = Nbligne
 
End Sub

Si vous avez des remarques n'hésiter pas, A+

[Qwazerty]

Salut
Je fais juste 4 remarques

1er) Application.Cutcopymode = False est inutil puisque tu ne fait plus de copie

2eme) Pour améliore la vitesse et l'esthétique il est intéressant de rajouter la gestion du rafraichissement de l'affichage avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
application.ScreenUpdating = Flase
'Ici tu met ton code
application.UScreenpdating = True

3eme)Il est dommage de boucler sur 1450 si celles ci ne sont pas toute rempli, ou si un jour plus de 1450 lignes sont saisies d'ou la forme evolutive:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
'En supposant que la colonne A est systematiquement rempli, pas de cases vides
For N = 3 to cells(rows.count,"A").end(XlUp).Row
...
Next N

4eme)Comme l'avait preceisé Casefayere la variable x doit etre initialisé diferement de x=5, sinon au 2eme lancement de la macro, on recommence a mettre les ligne a partir de la ligne 5 et donc on ecrase les entrées deja presentes, mais peut etre est ce le resultat recherché, si ca n'est pas le cas, Casefayere a mis la modification dans l'un de ses messages.

Voila bon developpement
A++
Qwaz

[rvtoulon]

Qwazerty salut,
merci pour tes remarques judicieuses. j'ai appliquer tes deux premiers conseils et je t'en remercie.

j'ai également essayé ton code que j'ai adapté comme suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For N = 4 to cells(rows.count,"B").end(XlUp).Row
...
Next N

puisque en fait ma colonne A est vide et mon tableau commence à la B
mais ça ne marche pas. A l'heure actuel je devrais avoir 15 noms et il ne m'en affiche qu'un. Je lance mon code depuis la feuille Synthèse via un bouton. faut-il que je sois dans la feuille Bd.(c'est la feuille Bd qui contient les données que je veux récupérer).

quand au point 4 effectivement j'ai noté la remarque de casefayere et je garde cette ligne de code au chaud (lol) mais le résultat me convient comme cela (enfin pour l'instant....)

encore merci pour tes suggestions

[Qwazerty]

Salut
Null besoin d'être dans la feuille, mais par contre il faut le préciser a Excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For N = 4 to sheets("BD").cells(rows.count,"B").end(XlUp).Row
...
Next N

A++
Qwaz

[rvtoulon]

Re, Qwazerty
merci pour ces remarques, j'ai beaucoup appris avec ce code et je vous en remercie.
ce code fonctionne à merveille et je pense que ce message viens conclure cette discution,ainsi qu'une autre que j'avais ouverte sur ce forum, il y a quelques jours.(d'ailleurs incrites en résolu et délester, vu que le code que j'ai fonctionne mais je l'améliorerais + tard)
bref pour en revenir à cette discution voici donc le code final:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub PA()
'Sélection des PA 
 
Dim x As Integer, y As Integer, Nbligne As Long
Dim Bd As Worksheet, Synt As Worksheet
Set Bd = Worksheets("Bd")
Set Synt = Worksheets("Synthèse")
 
 
Application.ScreenUpdating = False
With Bd
x = 5
For y = 4 To Bd.Cells(Rows.Count, "B").End(xlUp).Row
If .Range("D" & y) = "PA" Then
    Synt.Range("A" & x) = .Range("B" & y)
    Synt.Range("B" & x) = .Range("C" & y)
    x = x + 1
End If
Next y
End With
 
[TabPA].RemoveDuplicates Columns:=2, Header:=xlYes
Nbligne = [TabPA].Rows.Count
[C2] = Nbligne
Application.ScreenUpdating = True
 
End Sub

Encore merci et à bientôt