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

Question

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!


Configuration: Windows 8 / Chrome 23.0.1271.97

Heliotte · Answer

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

Heliotte · Answer

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 ;-)

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

2 réponses

Discussions similaires

Newsletters