Bonjour à tous,
Etant débutant en vba, je m'arrache les cheveux depuis quelques jours sur une petite macro...
J'ai un tableau dans une feuille dont l'une des colonnes contient une information "oui"/"non". Je voudrais sélectionner, pour toutes les lignes pour lesquelles il y a "oui" dans cette colonne certaines cellules non contigües (pas la ligne entière, donc) et les coller dans une autre feuille. J'espère être assez clair...
De plus, il faudrait que les cellules soient collées dans la deuxième feuille à partir de la ligne 15 pour laisser la place pour une en-tête...
Merci pour votre aide !
Voici le code que j'ai actuellement:
Sub CreationOnglets()
' COPIE DES LIGNES DESIREES DANS LES FEUILLES DE CALCUL DEDIEES
Dim Rw As Range
Dim Ligne As Long
' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)
Sheets("Inventaire des risques").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select
' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une deuxième feuille de calcul
For Each Rw In Selection.Rows
Ligne = Rw.Row
If Rw.Cells(1, 20).Value = "oui" Then
Rw.Range("B11,N1,P1,Q1,R1,S1").Copy Destination:=Worksheets("Sheet2").Cells(Ligne, 1).EntireRow
End If
Next Rw
' Supression des lignes vierges dans les feuilles de calcul récemment constituées
Sheets("Sheet2").Activate
With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
' Pop-up d'avertissement de fin de macro.
MsgBox "Planning annuel actualisé"
End Sub
Etant débutant en vba, je m'arrache les cheveux depuis quelques jours sur une petite macro...
J'ai un tableau dans une feuille dont l'une des colonnes contient une information "oui"/"non". Je voudrais sélectionner, pour toutes les lignes pour lesquelles il y a "oui" dans cette colonne certaines cellules non contigües (pas la ligne entière, donc) et les coller dans une autre feuille. J'espère être assez clair...
De plus, il faudrait que les cellules soient collées dans la deuxième feuille à partir de la ligne 15 pour laisser la place pour une en-tête...
Merci pour votre aide !
Voici le code que j'ai actuellement:
Sub CreationOnglets()
' COPIE DES LIGNES DESIREES DANS LES FEUILLES DE CALCUL DEDIEES
Dim Rw As Range
Dim Ligne As Long
' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)
Sheets("Inventaire des risques").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select
' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une deuxième feuille de calcul
For Each Rw In Selection.Rows
Ligne = Rw.Row
If Rw.Cells(1, 20).Value = "oui" Then
Rw.Range("B11,N1,P1,Q1,R1,S1").Copy Destination:=Worksheets("Sheet2").Cells(Ligne, 1).EntireRow
End If
Next Rw
' Supression des lignes vierges dans les feuilles de calcul récemment constituées
Sheets("Sheet2").Activate
With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
' Pop-up d'avertissement de fin de macro.
MsgBox "Planning annuel actualisé"
End Sub