Boucle copie-colle ligne avec condition de valeur d'une cellule
Fermé
Valentine06
-
1 juil. 2013 à 11:10
mapatos Messages postés 1 Date d'inscription samedi 15 février 2014 Statut Membre Dernière intervention 15 février 2014 - 15 févr. 2014 à 17:14
mapatos Messages postés 1 Date d'inscription samedi 15 février 2014 Statut Membre Dernière intervention 15 février 2014 - 15 févr. 2014 à 17:14
A voir également:
- Vba excel copier ligne vers autre feuille sous condition
- Aller à la ligne excel - Guide
- Liste déroulante excel - Guide
- Excel cellule couleur si condition texte - Guide
- Dessin sms copier coller zizi ✓ - Forum Réseaux sociaux
- Feuille de pointage excel - Télécharger - Tableur
3 réponses
f894009
Messages postés
17185
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
15 avril 2024
1 701
1 juil. 2013 à 17:03
1 juil. 2013 à 17:03
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+