je me remet un peux sur VBA mais j'ai toujours eu des souci avec les boucles :(, voici ce que je voudrais faire exactement:
Sur une feuille je voudrais rechercher des X dans une colonne si il y a présence d'un x je voudrais qu'il me copie la ligne sur une autre feuille et ainsi de suite ci dessous mon code simple mais je ne sais pas comment incrémenter une boucle pour qu'une fois le 1er x trouver il continue sa recherche, merci pour votre aide :)
Dim L1, L2, L3
Dim cell
Dim r
Data = "x"
Sheets.Add.Name = "Recherche Devis a faire"
Sheets("SUIVI VTL").Select
'recherche de la la croix "x" dans la colonne CU
For Each cell In Range(Cells(1, 99), Cells(65000, 99))
If cell.Value = Data Then
L1 = cell.Row
L3 = cell.End(xlUp).Row
Range("A1").Value = cell.Row
r = Cells(65536, 99).End(xlUp).Row
Range("B1").Value = L3
'Copy de la ligne avec "x" dans la page de ==> Recherche Devis a faire
Rows(L1).Select
Selection.Copy
Sheets("Recherche Devis a faire").Select
If Range("A1") = "" Then
Rows("1:1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
je ne suis pas un expert en la matière, mais voici comment je procèderais, le plus simplement possible :
' l'on considère que la recherche se fait
' dans l'onglet 1, et la copy dans l'onglet 2
'
' la colonne CU est la 99ième
'
' l'on considère qu'une colonne est toujours remplie
' ici la 1ère (si vide la boucle s'arrête)
code 1 : limite de recherche à la ligne n° 1 000
Sub Recherche_Devis_a_faire()
Dim ThClect As String, _
ThCcherche As String
Dim ThCboucl As Integer, _
ThCcopy As Integer
ThCcopy = 1
ThCcherche = "x"
For ThCboucle = 1 To 1 000
If Sheets(1).Cells(ThCboucle, 1) = "" Then Exit For
If Sheets(1).Cells(ThCboucle, 99) = ThCcherche Then
Rows(ThCboucle).Select
Selection.Copy
Sheets(2).Rows(ThCcopy).PasteSpecial
ThCcopy = ThCcopy + 1
End If
Next ThCboucle
End Sub
ou code 2 : recherche non limité au n° de ligne.
Sub Recherche_Devis_a_faire()
Dim ThClect As String, _
ThCrecherch As String
Dim ThCboucl As Integer, _
ThCcopy As Integer
ThCcopy = 1
ThCboucl = 1
ThCcherche = "x"
Do
ThClect = Sheets(1).Cells(ThCboucl, 1)
If Sheets(1).Cells(ThCboucl, 99) = ThCcherche Then
Rows(ThCboucl).Select
Selection.Copy
Sheets(2).Rows(ThCcopy).PasteSpecial
ThCcopy = ThCcopy + 1
End If
ThCboucl = ThCboucl + 1
Loop While ThClect <> ""
End Sub
Pour réaliser ce que tu souhaites faire... il y a plus rapide que les boucles (sur Excel) il y a les Filtres.
1 - Premier Onglet, tu filtres pour ne garder QUE les lignes contenant des "X"
Function AutoFilterOn(Nom_Feuille As String, Nom_range As Range)
' Active la feuille concernée
Sheets(Nom_Feuille).Activate
' Vérifie si un filtre existe, si non.. active le mode filtre
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range(Nom_range).AutoFilter
End If
End Function
Appliquer le filtre sur le caractère voulu
Function AutoFilterOn(Nom_Feuille As String, Nom_range As String, charFiltre As String, NumField As Integer)
'--------------------------------------
'Activer le mode Filtre automatique
'--------------------------------------
'NumField : N° colonne où filtrer
'charFiltre : caractère recherché
' Active la feuille concernée
Sheets(Nom_Feuille).Activate
' Vérifie si un filtre existe, si non.. active le mode filtre
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range(Nom_range).AutoFilter Field:=NumField, Criteria1:=charFiltre
End If
End Function
' Exemple d'utilisation :
Sub Macro1()
' Lance le filtre :
Fi = AutoFilterOn("Feuil1", "$A$1:$A$12", "z", 1)
End Sub
2 - Tu copies ces lignes dans ton autre feuille :
'Copier les données filtrées
Function Copie_Result_Filtre(NomFeuille1 As String, NomFeuille2 As String) As Boolean
'NomFeuille1 = Feuille contenant les données filtrées
'NomFeuille2 = Feuille qui recevra les données
Sheets(NomFeuille1).Activate
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets(NomFeuille2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'---------------------------------------
' Enlever la fenêtre de selection
ActiveSheet.Range("A1").Select
Sheets(NomFeuille1).Activate
ActiveSheet.Range("A1").Select
'---------------------------------------
End Function
"je ne sais pas comment incrémenter une boucle pour qu'une fois le 1er x trouver il continue sa recherche"
Ben, il te manque un NEXT quelque part, comme le dit jordane...
La boucle "FOR EACH" se referme avec l'instruction "NEXT" pour passer à l'élément suivant. De plus, ton code ne semble pas correcte pour la recherche dans FOR EACH, mais bon...
- Messages postés
-
2
- Date d'inscription
- mardi 3 décembre 2013
- Statut
- Membre
- Dernière intervention
- 3 décembre 2013
1J'ai noté une faute :
- ' dans l'onglet 1, et la copy dans l'onglet 2
- copy s'écrit copie
plus une erreur de frappe dans le code 2 :
- ThCrecherch As String
est plutôt
- ThCrecherche As String
je rajoute ce commentaire car je n'ai pas trouvé comment corriger ces erreurs.
.