Copier/coller si mot clée sinon copier
Bonjour,
étant débutant en vba je bloque sur un point j'arrive a copier coller si retour d'un mot clés, mais je bloque sur ma boucle(si sinon).
SI
Sub EcfiltreAGM()
Dim strSearch
Dim rg As Range, rgF As Range
Dim i As Integer
Application.ScreenUpdating = False
strSearch = ("AGM")
'On défini ici la plage de cellules contenant les données
' comme étant la région autour de la cellule 1 (A1)
Set rg = Sheets("Import l1").Cells(1).CurrentRegion
'On boucle sur chaque ligne de la plate
For i = 1 To rg.Rows.Count
'On cherche dans cette ligne la valeur à trouver
Set rgF = rg.Rows(i).Find(strSearch, , xlValues, xlPart)
'Si on la trouve alors rgF n'est pas vide, on copie dans notre onglet Résultats
If Not rgF Is Nothing Then
rg.Rows(i).Copy Sheets("Encours AGM").Range("A60000").End(xlUp).Offset(1, 0)
Set rgF = Nothing
End If
Next i
Application.ScreenUpdating = True
SInon
Copier meme feuille mes vers cellule g.
End Sub
Merci d'avance car je suis bloquer x)
Bonjour,
regarde le dernier fichier joint sur le lien suivant:
https://forum.excel-pratique.com/excel/index-equiv-t99078.html
Merci je vais test et je reviens vers vous pour mettre la solution.
Merci du retour !
je suis bloque sur comment je vais faire pour rentrer dans la boucle
if strSearch = "LD5"
Faire mon code
else
supprimer mes ligne ld5 et les copier les autres sur une autre colonne.
en if
dans l 'idée s 'est sa car le fichier james 007 même bien expliquer est assez costaud x)
dans l 'idée s 'est sa car le fichier james 007 même bien expliqué est assez costaud x)
Je suis à peu près sûr que mon surpoids n'a rien à voir avec ta macro ....
Pourquoi ne pas joindre ton fichier avec ta macro ... même à l'état de brouillon ...
je nettoie le code et je reviens vers vous =)! merci encore
Si tu as envie de nettoyer le code ... et de le faire fonctionner ... no problemo ...
Surtout quavec toutes les explications d'Isabelle qui sont vraiment parfaites ... cela devrait te faciliter la tâche ...
Veuillez m'excusez de mon retour tardif car mon pc est mort le week end de ma question x), après de nombre aventure me revoila!
Sub Ecfiltreig()
Dim strSearch
Dim rg As Range, rgF As Range
Dim i As Integer
Application.ScreenUpdating = False
strSearch = ("L5")
if strSearch > 1
'On défini ici la plage de cellules contenant les données
' comme étant la région autour de la cellule 1 (A1)
Set rg = Sheets("Import bgsq").Cells(1).CurrentRegion
'On boucle sur chaque ligne de la plate
For i = 1 To rg.Rows.Count
'On cherche dans cette ligne la valeur à trouver
Set rgF = rg.Rows(i).Find(strSearch, , xlValues, xlPart)
'Si on la trouve alors rgF n'est pas vide, on copie dans notre onglet Résultats
If Not rgF Is Nothing Then
rg.Rows(i).Copy Sheets("Encours BSG").Range("A60000").End(xlUp).Offset(1, 0)
Set rgF = Nothing
End If
Else
je recherche ( copier coller toute les lignes qui non pas ce mot la dans la meme feuille colone h mais je le ferais en tableau croisé
End if
Next i
Application.ScreenUpdating = True
End Sub
ps : le code de recherche marche mais je bloque sur la partie boucle.
Bonjour,
Déjà évoqué .... dans le Message #5 ....
Pourquoi ne pas joindre ton fichier avec ta macro ...
Par ailleurs ... si tu ne veux poster que du code ... il ne faut pas hésiter à utiliser les balises Code ...
Dans l'idée s 'est classeur qui va cherche deux autres classeur et après il fait le trie (sur un filtre) mais j'utilise par mot clée car débutant en vba
Sub Importglobal()
Importencour
Importstock
Importglobal
End Sub
Sub Importencour()
Workbooks.Open Filename:="..\global livraison.xlsx"
Workbooks("global livraison.xlsx").Worksheets("Import EC").Cells.ClearContents ' Efface le contenu de la feuille qui va recevoir les données
Workbooks.Open Filename:="..\En_Cours.xlsx" 'Ouvre le fichier Excel source
Workbooks("En_Cours.xlsx").Worksheets("Liste des OF").Cells.Copy _
Workbooks("global livraison.xlsx").Worksheets("Import EC").Range("A1") 'Copie-colle le fichier
Workbooks("En_Cours.xlsx").Close False
Workbooks("global livraison.xlsx").Close True
End Sub
Sub Importstock()
Workbooks.Open Filename:="..\global livraison.xlsx"
Workbooks("global livraison.xlsx").Worksheets("Import Stock").Cells.ClearContents ' Efface le contenu de la feuille qui va recevoir les données
Workbooks.Open Filename:="..\En_Cours.xlsx" 'Ouvre le fichier Excel source
Workbooks("En_Cours.xlsx").Worksheets("Liste des OF").Cells.Copy _
Workbooks("global livraison.xlsx").Worksheets("Import Stock").Range("A1") 'Copie-colle le fichier
Workbooks("En_Cours.xlsx").Close False 'Referme le fichier source
Workbooks("global livraison.xlsx").Close True 'Referme le fichier destinataire
End Sub
Sub Importfichierglobal()
Path = "..\import\"
Filename = Dir(Path & "Gobal*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy after:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
Sub EcfiltreIC()
Dim strSearch
Dim rg As Range, rgF As Range
Dim i As Integer
Application.ScreenUpdating = False
strSearch = ("IC")
'test suppression
'Workbooks("global livraison.xlsx").Worksheets("Import EC").Cells.ClearContents
'test suppression
'On défini ici la plage de cellules contenant les données
' comme étant la région autour de la cellule 1 (A1)
Set rg = Sheets("Import EC").Cells(1).CurrentRegion
'On boucle sur chaque ligne de la plate
For i = 1 To rg.Rows.Count
'On cherche dans cette ligne la valeur à trouver
Set rgF = rg.Rows(i).Find(strSearch, , xlValues, xlPart)
'Si on la trouve alors rgF n est pas vide, on copie dans notre onglet Résultats
If Not rgF Is Nothing Then
rg.Rows(i).Copy Sheets("Encours IC").Range("A60000").End(xlUp).Offset(1, 0)
Set rgF = Nothing
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub EcfiltreIG()
Dim strSearch
Dim rg As Range, rgF As Range
Dim i As Integer
Application.ScreenUpdating = False
strSearch = ("IG")
'On défini ici la plage de cellules contenant les données
' comme étant la région autour de la cellule 1 (A1)
Set rg = Sheets("Import EC").Cells(1).CurrentRegion
'On boucle sur chaque ligne de la plate
For i = 1 To rg.Rows.Count
'On cherche dans cette ligne la valeur à trouver
Set rgF = rg.Rows(i).Find(strSearch, , xlValues, xlPart)
'Si on la trouve alors rgF n est pas vide, on copie dans notre onglet Résultats
If Not rgF Is Nothing Then
rg.Rows(i).Copy Sheets("Encours IG").Range("A60000").End(xlUp).Offset(1, 0)
Set rgF = Nothing
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub EcfiltreIL()
Dim strSearch
Dim rg As Range, rgF As Range
Dim i As Integer
Application.ScreenUpdating = False
strSearch = ("IL")
'On défini ici la plage de cellules contenant les données
' comme étant la région autour de la cellule 1 (A1)
Set rg = Sheets("Import EC").Cells(1).CurrentRegion
'On boucle sur chaque ligne de la plate
For i = 1 To rg.Rows.Count
'On cherche dans cette ligne la valeur à trouver
Set rgF = rg.Rows(i).Find(strSearch, , xlValues, xlPart)
'Si on la trouve alors rgF n'est pas vide, on copie dans notre onglet Résultats
If Not rgF Is Nothing Then
rg.Rows(i).Copy Sheets("Encours IL").Range("A60000").End(xlUp).Offset(1, 0)
Set rgF = Nothing
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub ImportNONQUALITE()
Dim strSearch
Dim rg As Range, rgF As Range
Dim i As Integer
Application.ScreenUpdating = False
strSearch = ("L5")
if strSearch > 1
'On défini ici la plage de cellules contenant les données
' comme étant la région autour de la cellule 1 (A1)
Set rg = Sheets("Import IL").Cells(1).CurrentRegion
'On boucle sur chaque ligne de la plate
For i = 1 To rg.Rows.Count
'On cherche dans cette ligne la valeur à trouver
Set rgF = rg.Rows(i).Find(strSearch, , xlValues, xlPart)
'Si on la trouve alors rgF n'est pas vide, on copie dans notre onglet Résultats
If Not rgF Is Nothing Then
rg.Rows(i).Copy Sheets("Encours IL").Range("A60000").End(xlUp).Offset(1, 0)
Set rgF = Nothing
End If
Else
je recherche ( copier coller toute les lignes qui non pas ce mot la dans la meme feuille colone h mais je le ferais en tableau croisé
End if
Next i
Application.ScreenUpdating = True
End Subtu veux que je mette les fichier excel en ci-joint? merci
Sub NONQUALITE() ' test import stock validé
' // Copie des lignes desirées dans les feuilles de calcul dédiées
Dim PlageUtile As Range
Dim Ligne As Range
Dim Origine As Worksheet
Dim Destination As Worksheet
Dim LigneDestination As Integer
Set Origine = Worksheets("Import IL")
Set Destination = Worksheets("Non qualite")
si ligne destination = "nnqualite"
Set PlageUtile = Range(Origine.Cells(1, 1), Origine.Cells(1, 1).SpecialCells(xlLastCell))
MsgBox "Attention, nous allons travailler sur la plage " & PlageUtile.Address
LigneDestination = 1
For Each Ligne In PlageUtile.Rows
If Ligne.Cells(1, 3).Value = "nnqualite" Then
Ligne.Copy Destination.Cells(LigneDestination, 1)
LigneDestination = LigneDestination + 1
End If
Next
sinon
copier dans autre sheets
End Sub