Créer une boucle pour copier coller des données selon une cellule
C
Bonjour à tous, je lance cette discussion car j'ai un très gros problème avec une boucle for que je n'arrive pas à créer et j'aurais besoin de l'aide des experts en excel.
| J'aimerai créer une macro avec une boucle qui vient : |
| 1) Récupérer la référence en A2 (liste capa_opé) et la copier |
| 2) Se rendre sur Capacités opérationnelles, filtrer sur la référence copiée, filtrer sur opérationnelle |
| 3) Copier les noms des opérateurs |
| 4) Les coller sous la référence en C2 (liste capa_opé) |
| 5) Faire pareil avec la cellule A3, jusqu'à arriver à la fin de la lsite de référence en colonne A |
| --> Une fois que toutes les références sont renseignées, on supprime de la cellule C2 à NG2 pour ne plus avoir "Prénom" |
| Je pense à une boucle for next mais je n'arrive pas à la programmer |
| J'ai commencé un code mais je n'arrive pas à créer la boucle |
| Je vous remercie pour votre aide ! |
E
Bonjour,
Le code génère un nouvel onglet.
Option Explicit
Sub ListerLesPrenomsParReference()
Dim I As Integer, J As Integer, DerniereLigne As Integer, DerniereColonne As Integer, LigneEnCours As Integer
Dim AireCapa As Range, AireReferences As Range
Dim ShEtat As Worksheet
Application.ScreenUpdating = False
With Sheets("Liste Capa_opé")
DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
Set AireCapa = .Range(.Cells(2, "A"), .Cells(DerniereLigne, "A"))
End With
With Sheets("Capacités opérationnelles")
DerniereLigne = .Cells(.Rows.Count, "B").End(xlUp).Row
Set AireReferences = .Range(.Cells(2, "B"), .Cells(DerniereLigne, "B"))
End With
Set ShEtat = Sheets.Add(After:=Sheets(Sheets.Count))
With ShEtat
AireCapa.Copy
.Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
DerniereColonne = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set AireCapa = .Range(.Cells(1, 1), .Cells(1, DerniereColonne))
For I = 1 To AireCapa.Count
LigneEnCours = 2
For J = 1 To AireReferences.Count
If AireCapa(I) = AireReferences(J) Then
With AireCapa(I)
.Offset(LigneEnCours - 1, 0) = AireReferences(J).Offset(0, 2)
LigneEnCours = LigneEnCours + 1
End With
End If
Next J
Next I
.ListObjects.Add xlSrcRange, Range("$A$1").CurrentRegion, , xlYes
With .ListObjects(1)
.Range.Borders.LineStyle = xlNone
.Range.EntireColumn.AutoFit
.HeaderRowRange.Font.ThemeColor = xlThemeColorDark1
End With
End With
ActiveWindow.DisplayGridlines = False
Set AireCapa = Nothing: Set AireReferences = Nothing
Set ShEtat = Nothing
Application.ScreenUpdating = True
End SubC
Bonjour, je vous remercie, cela correspond à ce que je voulais, merci beaucoup et bonne continuation !