Macro rechercheV
khalilB
-
Mike-31 Messages postés 19572 Date d'inscription Statut Contributeur Dernière intervention -
Mike-31 Messages postés 19572 Date d'inscription Statut Contributeur Dernière intervention -
Bonsoir,
je suis très novice ne programmation VBA, et je dois créer une macro qui cherche une valeur dans une feuille d'un classeur, et une fois elle trouve la valeur, copie la ligne entière et la colle dans une nouvelle feuille à la ligne numéro 2 étant donner que la première ligne contient les intitulés des colonnes, puis elle recherche de nouveau et copie la nouvelle ligne juste en dessous de la première.
Merci pour votre aide
je suis très novice ne programmation VBA, et je dois créer une macro qui cherche une valeur dans une feuille d'un classeur, et une fois elle trouve la valeur, copie la ligne entière et la colle dans une nouvelle feuille à la ligne numéro 2 étant donner que la première ligne contient les intitulés des colonnes, puis elle recherche de nouveau et copie la nouvelle ligne juste en dessous de la première.
Merci pour votre aide
A voir également:
- Macro rechercheV
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Excel récupérer couleur cellule sans macro ✓ - Forum Bureautique
- Macro maker - Télécharger - Divers Utilitaires
2 réponses
Bonjour,
voici une macro qui peut t'aider. pour mieux la comprendre, appuies sur F8, ca éxécuteras le code ligne par ligne.
Sub x()
valeur = "valeurcherchée" 'remplace valeurcherchée par la valeur que tu cherches
a = 2
j = 1
Do While Sheets("sheet1").Cells(i, j) <> "" 'va balayer toutes tes colonnes une par une
i = 1
Do While Sheets("sheet1").Cells(i, j) <> "" 'va balayer toutes tes lignes une par une
Cells(i, j).Select
If Cells(i, j) = valeur Then 'si la cellule contient la valeur cherchée
Rows(i).Copy 'on copie la ligne
Sheets("Sheets2").Select 'on sélectionnes la feuille d'arrivée
Rows(a).Select
ActiveSheet.Paste 'on colles la ligne
a = a + 1
End If
i = i + 1
Loop
j = j + 1
Loop
End Sub
rq1 :remplace sheet1 par le nom de feulle u tu dois chercherla valeur
rq2 : remplace sheet2 pour le nom de feuille ou tu veux que ce soit copier.
voici une macro qui peut t'aider. pour mieux la comprendre, appuies sur F8, ca éxécuteras le code ligne par ligne.
Sub x()
valeur = "valeurcherchée" 'remplace valeurcherchée par la valeur que tu cherches
a = 2
j = 1
Do While Sheets("sheet1").Cells(i, j) <> "" 'va balayer toutes tes colonnes une par une
i = 1
Do While Sheets("sheet1").Cells(i, j) <> "" 'va balayer toutes tes lignes une par une
Cells(i, j).Select
If Cells(i, j) = valeur Then 'si la cellule contient la valeur cherchée
Rows(i).Copy 'on copie la ligne
Sheets("Sheets2").Select 'on sélectionnes la feuille d'arrivée
Rows(a).Select
ActiveSheet.Paste 'on colles la ligne
a = a + 1
End If
i = i + 1
Loop
j = j + 1
Loop
End Sub
rq1 :remplace sheet1 par le nom de feulle u tu dois chercherla valeur
rq2 : remplace sheet2 pour le nom de feuille ou tu veux que ce soit copier.
Salut,
Une autre approche, on saisi le valeur cherchée Feuil1 en D1, les valeurs à chercher sont Feuil1 colonne A si la valeur existe la ligne est copiée à la suite des données Feuil2 si la valeur n'existe pas gestion d'erreur avec msgbox
Sub Copie_Valeur_Trouvée()
Dim x
On Error GoTo errHandler
Sheets("Feuil1").Range("D1").Select
x = ActiveCell.Value
With Worksheets("Feuil1").Range("A:A")
Set c = .Find(x, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
End If
End With
Range(firstAddress).Select
ActiveCell.EntireRow.Copy
Sheets("Feuil2").Select
[A65536].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
MsgBox "La ligne a été copiée feuille 2"
Exit Sub
errHandler:
MsgBox "La valeur n'existe pas"
End Sub
Si tu as besoin d'un modèle fais signe
Une autre approche, on saisi le valeur cherchée Feuil1 en D1, les valeurs à chercher sont Feuil1 colonne A si la valeur existe la ligne est copiée à la suite des données Feuil2 si la valeur n'existe pas gestion d'erreur avec msgbox
Sub Copie_Valeur_Trouvée()
Dim x
On Error GoTo errHandler
Sheets("Feuil1").Range("D1").Select
x = ActiveCell.Value
With Worksheets("Feuil1").Range("A:A")
Set c = .Find(x, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
End If
End With
Range(firstAddress).Select
ActiveCell.EntireRow.Copy
Sheets("Feuil2").Select
[A65536].End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
MsgBox "La ligne a été copiée feuille 2"
Exit Sub
errHandler:
MsgBox "La valeur n'existe pas"
End Sub
Si tu as besoin d'un modèle fais signe
encore une fois merci