Sujet Précédent Sujet Suivant

Macro pour recopier des lignes selon critères...

Fermé
Prise_cm Messages postés 5 Date d'inscription jeudi 10 janvier 2013 Statut Membre Dernière intervention 11 janvier 2013 - 10 janv. 2013 à 14:34
Heliotte Messages postés 1491 Date d'inscription vendredi 26 octobre 2012 Statut Membre Dernière intervention 28 janvier 2013 - 14 janv. 2013 à 13:17
Bonjour,
Je souhaiterais trouver la macro qui me permette de: sur une colonne donnée (ex: colonne C -- Quantité) de contrôler le contenu n afin d'insérer (n-1) de lignes entre deux cellules différentes.
Exemple : C1=1, passer à la cellule suivante,
C19=14, recopier la ligne 19, 13 fois et remplacer la valeur C19 par C19=1.
Ainsi de suite
Merci!


2 réponses

Réponse 1 / 2
Heliotte Messages postés 1491 Date d'inscription vendredi 26 octobre 2012 Statut Membre Dernière intervention 28 janvier 2013 92
Modifié par Heliotte le 10/01/2013 à 15:56
Bonjour Prise_cm,

Bon, eh bien je l'ai fait vers le bas et ça fonctionne: 

Public Sub VerifierNombreEtInsererLignes()
    Const NoCol As Integer = 3
    Const NoLigMin As Integer = 2
    Const NoLigMax As Integer = 7
    Dim i As Integer, NoLigEnCours As Integer, ValCellule As Long
    '
    NoLigEnCours = NoLigMin
    With Worksheets("Feuil2").Select
        For i = NoLigMin To NoLigMax
            ValCellule = Cells(NoLigEnCours, NoCol).Value
            If (ValCellule > 1) Then
                'Rows("15:17").Select
                'Cells(NoLigEnCours, NoCol).Value
                Rows((NoLigEnCours + 1) & ":" & (NoLigEnCours + ValCellule - 1)).Select
                Selection.Insert Shift:=xlDown
                NoLigEnCours = (NoLigEnCours + ValCellule)
            Else
                NoLigEnCours = (NoLigEnCours + 1)
            End If
        Next i
    End With
End Sub
0
Prise_cm Messages postés 5 Date d'inscription jeudi 10 janvier 2013 Statut Membre Dernière intervention 11 janvier 2013
11 janv. 2013 à 05:53
Merci Heliotte,
Seulement la macro créé des lignes vides au lieu de recopier des lignes identiques.
0
Heliotte Messages postés 1491 Date d'inscription vendredi 26 octobre 2012 Statut Membre Dernière intervention 28 janvier 2013 92
11 janv. 2013 à 07:13
Bonjour Prise_cm,

Ok, il te suffit de prendre la valeur de chaque cellule de la ligne .. et de collé pour les autres lignes.
0
Prise_cm Messages postés 5 Date d'inscription jeudi 10 janvier 2013 Statut Membre Dernière intervention 11 janvier 2013
11 janv. 2013 à 11:52
Ok, la question c'est : A quel niveau se ferait la recopie...
0
Heliotte Messages postés 1491 Date d'inscription vendredi 26 octobre 2012 Statut Membre Dernière intervention 28 janvier 2013 92
11 janv. 2013 à 11:57
Dans ton vrai fichier, il n'y a qu'une seule cellule à copier ou plusieurs cellules ?

J'ai besoin des noms des colonnes : A, B, C, etc.
0
Prise_cm Messages postés 5 Date d'inscription jeudi 10 janvier 2013 Statut Membre Dernière intervention 11 janvier 2013
11 janv. 2013 à 15:55
Il y en a plusieurs. A, B, C, D, E, F.
Exemple, la ligne A;B;C;D;E;F contenant les informations suivantes :
"Interphones SSIS Bouyer PS 1155";221101;4;181648;DFOO;181648 (j'ai séparé avec ";") serait éclatée en 4 lignes suivantes:
"Interphones SSIS Bouyer PS 1155";221101;1;181648;DFOO;181648
"Interphones SSIS Bouyer PS 1155";221101;1;181648;DFOO;181648
"Interphones SSIS Bouyer PS 1155";221101;1;181648;DFOO;181648
"Interphones SSIS Bouyer PS 1155";221101;1;181648;DFOO;181648
la ligne d'origine serait alors remplacée par 4 lignes identiques. 4 c'est la valeur initialement contenue dans la cellule de la colonne C.
0
Réponse 2 / 2
Heliotte Messages postés 1491 Date d'inscription vendredi 26 octobre 2012 Statut Membre Dernière intervention 28 janvier 2013 92
11 janv. 2013 à 16:38 
Public Sub VerifierNombreEtInsererLignes()
    Const NoCol As Integer = 3
    Const NoLigMin As Integer = 2
    Const NoLigMax As Integer = 7
    Dim i As Integer, j As Integer, NoLigEnCours As Integer
    ' déclaration pour une ligne de six colonnes
    Dim CellA As String, CellB As Long, CellC As Long, CellD As Long, CellE As String, CellF As Long
    '
    NoLigEnCours = NoLigMin
    With Worksheets("Feuil2").Select
        For i = NoLigMin To (NoLigMax + 1)
            CellC = Cells(NoLigEnCours, NoCol).Value
            If (CellC > 1) Then
                CellA = Cells(NoLigEnCours, 1).Value
                CellB = Cells(NoLigEnCours, 2).Value
                CellD = Cells(NoLigEnCours, 4).Value
                CellE = Cells(NoLigEnCours, 5).Value
                CellF = Cells(NoLigEnCours, 6).Value
                Rows((NoLigEnCours + 1) & ":" & (NoLigEnCours + CellC - 1)).Select
                Selection.Insert Shift:=xlDown
                For j = 0 To (CellC - 1)
                    Cells(NoLigEnCours + j, 1).Value = CellA
                    Cells(NoLigEnCours + j, 2).Value = CellB
                    Cells(NoLigEnCours + j, 3).Value = 1
                    Cells(NoLigEnCours + j, 4).Value = CellD
                    Cells(NoLigEnCours + j, 5).Value = CellE
                    Cells(NoLigEnCours + j, 6).Value = CellF
                Next j
                NoLigEnCours = (NoLigEnCours + CellC)
            Else
                NoLigEnCours = (NoLigEnCours + 1)
            End If
        Next i
    End With
End Sub


Heureux ;-)
0
Prise_cm
14 janv. 2013 à 11:34
C impeccable. Merci infiniment Heliotte.
0
Heliotte Messages postés 1491 Date d'inscription vendredi 26 octobre 2012 Statut Membre Dernière intervention 28 janvier 2013 92
14 janv. 2013 à 13:17
@+
0

Discussions similaires

Index+Equiv avec 3 critères
CCB91 -
soignisec -

2 réponses
Afficher toutes les lignes masquées excel
livlarsen -
esicom -

26 réponses
je veut créer des codes
jonkiller -
Nhhi -

20 réponses
Fonction INDEX/EQUIV - 2 critères Colonne & 1 critère Ligne
florntn -
florntn -

2 réponses
Addition avec plusieurs critères au sein d'une même colonne
Chti_perdue -
Chti_perdue -

12 réponses