Si cellule contient x copier cellule plus 5 suivantes

[boulbidule]

Bonjour à tous,

j'aurai une question,

je cherche un moyen d'automatiser une récupération de données,

sur mon fichier 1,tout est dans la colonne A,avec des cellules les unes sous les autres

j'aimerai un bouton qui cherche : si cellule contient xxx copier cellule et les 5 du dessous dans colonne A fichier 2

cela correspond à : si cellule contient adresse alors copier dans second fichier adresse complète (vu que formatée par cellule les unes sous les autres)

c'est faisable ?

merci à tous 🙂

 

[boulbidule]

Re : Si cellule contient x copier cellule plus 5 suivantes



voilà en image,si cellule contient le mot "L'adresse"
copier toute la suite soit 6 cellules pour ce cas

 

[adel53]

Re : Si cellule contient x copier cellule plus 5 suivantes

Bonjour Peux tu joindre un fichier avec 3-4 exemple stp

 

[boulbidule]

Re : Si cellule contient x copier cellule plus 5 suivantes

Bonjour Peux tu joindre un fichier avec 3-4 exemple stp

bonjour adel 🙂

à l'origine c'est un csv que je viens de te mettre en xlsx

merci

 

[Staple1600]

Re : Si cellule contient x copier cellule plus 5 suivantes

Bonsoir à tous

Si j'ai bien compris
(il faut qu'il y ait une feuille 2 dans le classeur avant de lancer la macro)

Sub a()
Dim c As Range, i&
i = 1
Application.ScreenUpdating = False
For Each c In Columns(1).SpecialCells(xlCellTypeConstants, 2)
If c Like "nom*" Then
'ici adapter en changeant le chiffre 4 (selon le nombre de lignes à copier)
c.Resize(4).Copy
Sheets(2).Cells(i, 1).Resize(, 4).PasteSpecial Paste:=xlPasteAll, Transpose:=True
'idem sur cette ligne ci-dessus changer la valeur du 4 selon la valeur mise dans c.Resize(4).Copy
i = i + 1
End If
Next c
Application.ScreenUpdating = True
End Sub

 

[jamespatagueul]

Re : Si cellule contient x copier cellule plus 5 suivantes

Bonsoir à tous

Si j'ai bien compris
(il faut qu'il y ait une feuille 2 dans le classeur avant de lancer la macro)

Sub a()
Dim c As Range, i&
i = 1
Application.ScreenUpdating = False
For Each c In Columns(1).SpecialCells(xlCellTypeConstants, 2)
If c Like "nom*" Then
'ici adapter en changeant le chiffre 4 (selon le nombre de lignes à copier)
c.Resize(4).Copy
Sheets(2).Cells(i, 1).Resize(, 4).PasteSpecial Paste:=xlPasteAll, Transpose:=True
'idem sur cette ligne ci-dessus changer la valeur du 4 selon la valeur mise dans c.Resize(4).Copy
i = i + 1
End If
Next c
Application.ScreenUpdating = True
End Sub

Bonjour Tous,Staple1600
super le code.
Peut on l'utiliser avec une inputbox pour rechercher par mot variable.
Merci

 

[boulbidule]

Re : Si cellule contient x copier cellule plus 5 suivantes

bonjour tout le monde et merci staples 🙂
vous l'aurez compris,james me file un coup de main également 🙂
merci à tous

 

[Staple1600]

Re : Si cellule contient x copier cellule plus 5 suivantes

Bonsoir à tous

Bonjour Tous,Staple1600
super le code.
Peut on l'utiliser avec une inputbox pour rechercher par mot variable.
Merci

Donc avec un InputBox

Sub b()
Dim c As Range, i&, sValeur
i = 1
Application.ScreenUpdating = False
sValeur = InputBox("Valeur cherchée ?", "Recherche", "Saisir le mot cherché")
For Each c In Columns(1).SpecialCells(xlCellTypeConstants, 2)
If c Like sValeur & "*" Then
'ici adapter en changeant le chiffre 4 (selon le nombre de lignes à copier)
c.Resize(4).Copy
Sheets(2).Cells(i, 1).Resize(, 4).PasteSpecial Paste:=xlPasteAll, Transpose:=True
'idem sur cette ligne ci-dessus changer la valeur du 4 selon la valeur mise dans c.Resize(4).Copy
i = i + 1
End If
Next c
Application.ScreenUpdating = True
End Sub

 

[jamespatagueul]

Re : Si cellule contient x copier cellule plus 5 suivantes

Bonsoir à tous


Donc avec un InputBox

Sub b()
Dim c As Range, i&, sValeur
i = 1
Application.ScreenUpdating = False
sValeur = InputBox("Valeur cherchée ?", "Recherche", "Saisir le mot cherché")
For Each c In Columns(1).SpecialCells(xlCellTypeConstants, 2)
If c Like sValeur & "*" Then
'ici adapter en changeant le chiffre 4 (selon le nombre de lignes à copier)
c.Resize(4).Copy
Sheets(2).Cells(i, 1).Resize(, 4).PasteSpecial Paste:=xlPasteAll, Transpose:=True
'idem sur cette ligne ci-dessus changer la valeur du 4 selon la valeur mise dans c.Resize(4).Copy
i = i + 1
End If
Next c
Application.ScreenUpdating = True
End Sub

Bonsoir Tous,
merci staple1600,
je vais abuser
comment adapter ce code :
Sub A()

Dim mot As String
Dim feuille As Worksheet
Dim cellule As Range
Dim Ligne As Range
Dim cible As Range
'ActiveSheet.Next.Range("A1:Z1000").ClearContents
'//nettoyage de la feuille de recherche
Feuil2.Activate
mot = Application.InputBox("Valeur cherchée ?", "Recherche", "Saisir le mot cherché")
Feuil1.Range("f6").Value = mot
Set feuille = Feuil2
Set cible = Feuil3.Range("A1") 'ActiveSheet.Next.Range("A1")

For Each Ligne In feuille.UsedRange.Rows
For Each cellule In Ligne.Cells
If InStr(cellule.Text, mot) > 0 Then '// On a trouvé le mot dans une cellule de la ligne
Ligne.Copy Destination:=cible
Set cible = cible.Offset(1) '// Pas la peine de continuer à chercher dans cette ligne
Exit For
End If
Next
Next
'ActiveSheet.Next.Cells.Columns.AutoFit
'ActiveSheet.Next.Select
Feuil1.Activate

End Sub

pour coller l'une en dessous de l'autre toutes les lignes trouvées.
Merki.

 

[Staple1600]

Re : Si cellule contient x copier cellule plus 5 suivantes

Bonsoir tous

jamespatagueul
petit rappel
extrait de la charte du forum

3 – Le titre de la question doit être clair et comporter explicitement le sujet de la demande.
Cela sous-entend qu’une nouvelle demande fait l’objet d’un nouveau fil.

A te relire donc dans ta propre discussion pour y exposer ta question. 😉

 

[boulbidule]

Re : Si cellule contient x copier cellule plus 5 suivantes

un grand merci staple 😉