Boucle et Sélection et copie d'une ligne
Bonjour,
Je suis encore au stade d'apprentissage de ce language et j'ai encore quelques questions afin d'avancer mon projet :
Première question : Sélection et copie d'une ligne
Je cherche à
(1) Trouver la ligne dans la colonne A sur laquelle se trouve StringCible
(2) Copier les colonnes B à M de la ligne sur laquelle se trouve StringCible
(3) Trouver la ligne dans la colonne A sur laquelle se trouve StringCible2
(4) Coller les colonnes B à M de la ligne sur laquelle se trouvait StringCible dans les colonnes B à M de la ligne sur laquelle se trouve StringCible2
Deuxième question : Boucle permettant de trouver une ligne dans une colonne pour ensuite copier cette colonne dans une colonne Cible
Je cherche à
(1) Trouver la ligne dans la colonne A sur laquelle se trouve StringCible
(2) Balayer les colonnes E à M de cette ligne afin de trouver la première valeur correspondant à "Oui"
(3) Lorsque le premier "Oui" trouvé, copier la colonne dans laquelle se trouve le "Oui" et la copier dans la colonne D
Merci à l'avance!
Bonjour obeauregard, le forum,
23 vues et aucune réponse, un petit fichier peut-être ?
Cordialement,
Bonjour Xorsankukai,
Voici le fichier pour illustrer le tout. N'hésites pas si tu as des questions.
Merci beaucoup.
OB
Re,
Un essai....
Il y a certainement moyen d'optimiser,
Sub test()
Dim val1 As String, val2 As String
Dim cel1 As Range, cel2 As Range
Dim lig1 As Integer, lig2 As Integer, derlig As Integer
Dim i As Integer
Application.ScreenUpdating = False 'évite le scintillement de l'écran
With Sheets("AnalyseSalaireVsDividende")
derlig = .Range("A" & Rows.Count).End(xlUp).Row 'définit la dernière ligne utilisée de la colonne A
val1 = "StringCible" 'première valeur à trouver
val2 = "StringCible2" 'seconde valeur à trouver
Set cel1 = Range("A2:A" & derlig).Find(val1, lookat:=xlWhole) 'recherche première valeur
If cel1 Is Nothing Then 'si pas trouvée
Exit Sub 'on quitte
Else 'sinon
lig1 = cel1.Row 'on récupère le N° de la ligne
For i = 5 To 13 'on boucle sur les colonnes E à M
If Cells(2, i) = "Oui" Then 'si en ligne 2 on a Oui
.Range(Cells(1, i), Cells(derlig, i)).Copy 'on copie le contenu de la colonne en colonne D
.Cells(1, 4).PasteSpecial Paste:=xlPasteValues 'colle les valeurs uniquement
.Range(Cells(1, 4), Cells(derlig, 4)).Font.Color = vbRed 'police en rouge (optionnel)
Exit For 'on quitte la boucle pour s'arreter au premier Oui
End If 'fin de condition du Oui
Next i 'fin de boucle sur colonnes
End If 'fin de condition pour première valeur
Set cel2 = Range("A2:A" & derlig).Find(val2, lookat:=xlWhole) 'recherche seconde valeur
If cel2 Is Nothing Then 'si pas trouvée
Exit Sub 'on quitte
Else 'sinon
lig2 = cel2.Row 'on récupère le N° de la ligne
End If 'fin de condition seconde valeur
.Range("B" & lig1 & ":M" & lig1).Copy 'on écrit le contenu de la ligne de la première valeur
.Range("B" & lig2).PasteSpecial Paste:=xlPasteValues 'on colle les valeurs uniquement
.Range("B" & lig2 & ":M" & lig2).Font.Color = vbRed 'police en rouge (optionnel)
End With
Application.CutCopyMode = False '"deselectionne" les cellules copiées
End Subctrl + e pour exécuter la macro
Cordialement,