Discussion :

[mxitzny]

Bonjour, j'ai besoin de votre aide
J'ai crée une macro qui permet de chercher dans une feuille BD_produits (qui contient les produits, des chiffres, des calculs selon des formules) et me copie les lignes ou la ligne correspondante à ma recherche dans une feuille de destination mais ça ne réalise pas ce qui est attendu.

voici mon 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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub recherche()
 
 
Dim i As Integer, j As Integer, col As Integer
Dim pr As String
Dim w As Worksheet
Dim s As Worksheet
Dim max_ligne As Integer
Dim nb_max_ligne As Integer
Dim w_tab
Dim w_plage As Range
Set w = Worksheets("BD_Produits")
Set s = Worksheets("Destination")
 
col = Application.CountA(w.Rows(2))       'Compter le nombre des colonnes
nb_max_ligne = Application.CountA(w.Columns(9))    'Compter le nombre des lignes
max_ligne = Application.CountA(s.Columns(9)) + 1  'Trouver la cellule active
 
pr = InputBox(" Veuillez saisir le produit à copier ")
 
For i = 3 To nb_max_ligne
 
If pr = w.Cells(i, 1).Value Then
 
w.Rows(i).EntireRow.Copy
 
s.Rows(max_ligne).PasteSpecial xlPasteAll
End If
 
Next i
Exit Sub
If pr <> w.Cells(i, 1).Value Then
 MsgBox ("veuillez vérifier votre saisie")
Exit Sub
End If
Set w = Nothing
Set s = Nothing
End Sub

Merci d'avance

[parmi]

mais ça ne réalise pas ce qui est attendu.

Et qu'Est-ce qui attendu qui ne fonctionne pas ?
Je pense que ça copie toujours sur la même ligne... c'est ça ?
Si oui, mets à l'intérieur de ta boucle:

Code :

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

max_ligne = Application.CountA(s.Columns(9)) + 1  'Trouver la cellule active

ou incrémente ta variable max_ligne de 1 à chaque copie, ce qui devrait être plus rapide et moins gourmand pour le système.

[mxitzny]

le problème c'est que ça me copie la dernière ligne qui contient les éléments à copier et les ligne précédentes non.

[parmi]

C'est donc ce que je pensais.
Ça copie tout sur la même ligne, donc tu ne vois que la dernière copie.

Augmente ta variable max_ligne de 1 à l'intérieur de ta boucle

[mxitzny]

Merci ça marche
J'ai voulu savoir si je veux créer un nouveau classeur et copier dedans.
Voici mon 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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Sub recherche()
 
 
Dim i As Integer, j As Integer, col As Integer
Dim st As String
Dim w As Worksheet
Dim s As Worksheet
Dim max_ligne As Integer
Dim nb_max_ligne As Integer
Dim XLApp As New Excel.Application
Dim XLBook As Workbook
Dim XLSheet As Worksheet
Set XLBook = XLApp.Workbooks.Add
Set XLSheet = XLBook.Worksheets.Add
 
Set w = Worksheets("BD_Produits")
Set s = XLBook.Worksheets(1)
 
col = Application.CountA(w.Rows(2))                'Compter le nombre des colonnes
nb_max_ligne = Application.CountA(w.Columns(9))    'Compter le nombre des lignes
max_ligne = Application.CountA(s.Columns(1)) + 1   'Trouver la cellule active
 
pr = InputBox(" Veuillez saisir le produit à copier ")
 
 
For i = 3 To nb_max_ligne
 
If st = w.Cells(i, 1).Value Then
 
w.Rows(i).EntireRow.Copy
 
s.Rows(max_ligne).PasteSpecial xlPasteAll
max_ligne = max_ligne + 1
End If
 
Next i
Exit Sub
If st <> w.Cells(i, 1).Value Then
 MsgBox ("veuillez vérifier votre saisie")
Exit Sub
End If
Set w = Nothing
Set s = Nothing
End Sub
ur dans lequel j'enregistre ma recherche comment faire SVP?
voila ce que j'ai fait

J'ai une erreur au niveau de la ligne 22
Merci pour votre aide

[parmi]

Inutile de faire ceci qui te crée une 2e instance d'Excel

Code :

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

1
2
3
4
5
6
Dim XLApp As New Excel.Application
...
Set XLBook = XLApp.Workbooks.Add
Set XLSheet = XLBook.Worksheets.Add
...
Set s = XLBook.Worksheets(1)

Essaie seulement ainsi

Code :

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

Set s = Worksheets.Add

Le code précédent va te créer une nouvelle feuille dans ton classeur.

Si tu veux créer un nouveau classeur et y copier tes données

Code :

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

1
2
3
Set xlBook = Workbooks.Add
Set s = ActiveWorkbook.Activesheet
.....