Re : Boucle excel
Ayant fait pas mal de macro en automatique, j'ai ensuite rassemblé plusieurs code, n'est ce pas trop brouillon?
sinon de ql collé parle tu?
Sub step1()
'
' JE SELECTIONNE LA FEUILLE SOURCE PDVI
Sheets("SOURCE_PDVI").Select
' j effectue un defusionnage et retire tous les retour a la ligne
Columns("A
").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("A
").Select
Columns("A
").EntireColumn.AutoFit
' j effectue une copie de completion sur les colonne A et B vers le bas
'les cellules vides seront renseignees de l'information trouvee juste au dessus d elles
Dim lignefin As Long, Tourne As Long
Dim MemSecu As String, MemChant As String
lignefin = Range("d" & Rows.Count).End(xlUp).Row
For Tourne = 2 To lignefin
If Range("A" & Tourne) <> "" Then
MemSecu = Range("A" & Tourne)
Else
Range("A" & Tourne) = MemSecu
End If
If Range("B" & Tourne) <> "" Then
MemChant = Range("B" & Tourne)
Else
Range("B" & Tourne) = MemChant
End If
Next Tourne
' ON AJOUTE UNE ENTETE CAR SI LA MACRO EST LANCEE A PLUSIEUR REPRISE LES NOM PEUVENT ETRE SUPRRIMER
'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "FONCTION"
Range("B1").Select
ActiveCell.FormulaR1C1 = "SECTEUR"
Range("C1").Select
ActiveCell.FormulaR1C1 = "NOM"
Range("D1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "CP"
End Sub
Sub step2()
'
' JE SELECTIONNE LA FEUILLE SOURCE PDVI
Sheets("SOURCE_PDVI").Select
' FILTREDATE Macro
'
Columns("D
").Select
Selection.AutoFilter
ActiveSheet.Range("$D$1:$D$10000").AutoFilter Field:=1, Criteria1:= _
"=Fin de validité", Operator:=xlOr, Criteria2:="="
' selectalletsupp (vide et fin validité) et suppression
'
Cells.Select
Selection.Delete Shift:=xlUp
' ON remets de nouveau UNE ENTETE CAR
'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "FONCTION"
Range("B1").Select
ActiveCell.FormulaR1C1 = "SECTEUR"
Range("C1").Select
ActiveCell.FormulaR1C1 = "NOM"
Range("D1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "CP"
' JE SELECTIONNE LA FEUILLE SOURCE PDVI
Sheets("SOURCE_PDVI").Select
' JE RECHERCHE LE NUMEROCP DE L AGENT ET LISOLE
Range("E2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-2],SEARCH(""("",RC[-2])+1,8)"
Range("E2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
' je relance un filtre en incluant CP
' FILTREDATE Macro
'
Columns("D
").Select
Selection.AutoFilter
ActiveSheet.Range("$D$1:$D$10000").AutoFilter Field:=1, Criteria1:= _
"=Fin de validité", Operator:=xlOr, Criteria2:="="
' selectalletsupp (vide et fin validité) et suppression
'
Cells.Select
Selection.Delete Shift:=xlUp
' ON remets de nouveau UNE ENTETE CAR
'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "FONCTION"
Range("B1").Select
ActiveCell.FormulaR1C1 = "SECTEUR"
Range("C1").Select
ActiveCell.FormulaR1C1 = "NOM"
Range("D1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "CP"
' uniformisation hauteur de ligne a 15
Cells.Select
Selection.RowHeight = 15
' je relance un filtre en incluant CP
' FILTREDATE Macro
'
'
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter
' JE RETIRE LA MISE EN FORME
'
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' JE COPY LES VALEUR DE LA SOURCE VERS L ONGLET FINALE ET COPIE LA FORME
End Sub
