Bonjour,
Je reviens vers vous avec un petit soucis.
J'aimerais qu'au final les étapes de ma Macro soit les suivantes :
- Trier les données par ordre croissant sur la colonne A
- Supprimer les lignes contenenant la lettre "W" dans la colonne A
- Créer 3 colonnes avec formules jusqu'à la dernière ligne non vide
Voici le code que j'ai essayé de faire mais qui comporte je pense quelques erreurs :
Merci d'avance,
Je reviens vers vous avec un petit soucis.
J'aimerais qu'au final les étapes de ma Macro soit les suivantes :
- Trier les données par ordre croissant sur la colonne A
- Supprimer les lignes contenenant la lettre "W" dans la colonne A
- Créer 3 colonnes avec formules jusqu'à la dernière ligne non vide
Voici le code que j'ai essayé de faire mais qui comporte je pense quelques erreurs :
Code:
Sub test()
Dim LastLig As Long
Dim LastLig2 As Long
Columns("A:A").Select
Selection.Sort Key1:=Range("A1")
Application.ScreenUpdating = False
With Sheets("Source")
.AutoFilterMode = False
LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:A65536" & LastLig).AutoFilter field:=1, Criteria1:="W"
On Error Resume Next
.Range("A2:A65536" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
.AutoFilterMode = False
End With
'Application.ScreenUpdating = False
'With Sheets("Source")
' .AutoFilterMode = False
' LastLig2 = .Cells(.Rows.Count, "R").End(xlUp).Row
' .Range("A1:A65536" & LastLig).AutoFilter field:=1, Criteria1:="Not taken up"
' On Error Resume Next
' .Range("A2:A65536" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
' On Error GoTo 0
' .AutoFilterMode = False
'End With
Dim c As Range, TopCell As Range, BottomCell As Range
Dim i As Long, j As Long
' boucle (nécessaire si plusieurs colonnes à remplir !)
For Each c In Selection.Rows(1)
' définition de la cellule supérieure
If Not IsEmpty(c) Then
Set TopCell = c
Else
Set TopCell = c.End(xlUp)
End If
' définition de la cellule inférieure
i = c.CurrentRegion.SpecialCells(xlCellTypeLastCell).Row
j = c.Column
Set BottomCell = Cells(i, j)
' remplissage
Range(TopCell, BottomCell).FillDown
Next c
Application.ScreenUpdating = True
End Sub
Merci d'avance,