A voir également:
- Vba excel copier ligne vers autre feuille sous condition
- Excel cellule couleur si condition texte - Guide
- Aller à la ligne excel - Guide
- Liste déroulante excel - Guide
- Feuille de pointage excel - Télécharger - Tableur
- Partager photos en ligne - Guide
3 réponses
Bonjour,
prevoir une raz sur l'onglet Contratsàrenouveler ou autre suivant ce que vous voulez faire de la liste cree.
Deux facons de faire:
'empilage inverse par decalage vers le bas
'suivant votre programmation de depart
'empilage normal par ecriture vers le bas
Bon courage
A+
prevoir une raz sur l'onglet Contratsàrenouveler ou autre suivant ce que vous voulez faire de la liste cree.
Deux facons de faire:
'empilage inverse par decalage vers le bas
'suivant votre programmation de depart
Sub Renouvellement_Inv() Dim plage As Range, cel As Range Application.ScreenUpdating = False valcherch = Sheets("Recherchecontratsparfournisseur").Range("E24") With Worksheets("BD") derlig = .Range("D" & Rows.Count).End(xlUp).Row Set plage = .Range("D9:D" & derlig) End With For Each cel In plage If cel <= valcherch Then cel.EntireRow.Copy Worksheets("Contratsàrenouveler").Range("A3").Select Selection.Insert Shift:=xlDown End If Next cel Application.ScreenUpdating = True End Sub
'empilage normal par ecriture vers le bas
Sub Renouvellement_Norm() Dim plage As Range, cel As Range 'stop rafraichissement ecran Application.ScreenUpdating = False 'valeur a chercher valcherch = Sheets("Recherchecontratsparfournisseur").Range("E24") With Worksheets("BD") 'derniere cellule colonne D derlig = .Range("D" & Rows.Count).End(xlUp).Row 'defintion plage a tester en memoire Set plage = .Range("D9:D" & derlig) End With derlig = 0 With Worksheets("Contratsàrenouveler") 'test plage For Each cel In plage If cel <= valcherch Then 'premiere cellule vide apres derniere non vide colonne D derlig = .Range("D" & Rows.Count).End(xlUp).Row + 1 'premier lancement If derlig = 2 Then derlig = 9 End If 'copy ligne entiere cel.EntireRow.Copy .Range("A" & derlig) End If Next cel End With 'rafraichissement ecran Application.ScreenUpdating = True End Sub
Bon courage
A+